;;; startup.el --- process Emacs shell arguments
;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
-;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
;;("-bw" . x-handle-numeric-switch)
;;("-d" . x-handle-display)
;;("-display" . x-handle-display)
- ("-name" 1 ns-handle-name-switch)
- ("-title" 1 ns-handle-switch title)
- ("-T" 1 ns-handle-switch title)
- ("-r" 0 ns-handle-switch reverse t)
- ("-rv" 0 ns-handle-switch reverse t)
- ("-reverse" 0 ns-handle-switch reverse t)
- ("-fn" 1 ns-handle-switch font)
- ("-font" 1 ns-handle-switch font)
- ("-ib" 1 ns-handle-numeric-switch internal-border-width)
+ ("-name" 1 x-handle-name-switch)
+ ("-title" 1 x-handle-switch title)
+ ("-T" 1 x-handle-switch title)
+ ("-r" 0 x-handle-switch reverse t)
+ ("-rv" 0 x-handle-switch reverse t)
+ ("-reverse" 0 x-handle-switch reverse t)
+ ("-fn" 1 x-handle-switch font)
+ ("-font" 1 x-handle-switch font)
+ ("-ib" 1 x-handle-numeric-switch internal-border-width)
;;("-g" . x-handle-geometry)
;;("-geometry" . x-handle-geometry)
- ("-fg" 1 ns-handle-switch foreground-color)
- ("-foreground" 1 ns-handle-switch foreground-color)
- ("-bg" 1 ns-handle-switch background-color)
- ("-background" 1 ns-handle-switch background-color)
-; ("-ms" 1 ns-handle-switch mouse-color)
- ("-itype" 0 ns-handle-switch icon-type t)
- ("-i" 0 ns-handle-switch icon-type t)
- ("-iconic" 0 ns-handle-iconic icon-type t)
+ ("-fg" 1 x-handle-switch foreground-color)
+ ("-foreground" 1 x-handle-switch foreground-color)
+ ("-bg" 1 x-handle-switch background-color)
+ ("-background" 1 x-handle-switch background-color)
+; ("-ms" 1 x-handle-switch mouse-color)
+ ("-itype" 0 x-handle-switch icon-type t)
+ ("-i" 0 x-handle-switch icon-type t)
+ ("-iconic" 0 x-handle-iconic icon-type t)
;;("-xrm" . x-handle-xrm-switch)
- ("-cr" 1 ns-handle-switch cursor-color)
- ("-vb" 0 ns-handle-switch vertical-scroll-bars t)
- ("-hb" 0 ns-handle-switch horizontal-scroll-bars t)
- ("-bd" 1 ns-handle-switch)
- ;; ("--border-width" 1 ns-handle-numeric-switch border-width)
+ ("-cr" 1 x-handle-switch cursor-color)
+ ("-vb" 0 x-handle-switch vertical-scroll-bars t)
+ ("-hb" 0 x-handle-switch horizontal-scroll-bars t)
+ ("-bd" 1 x-handle-switch)
+ ;; ("--border-width" 1 x-handle-numeric-switch border-width)
;; ("--display" 1 ns-handle-display)
- ("--name" 1 ns-handle-name-switch)
- ("--title" 1 ns-handle-switch title)
- ("--reverse-video" 0 ns-handle-switch reverse t)
- ("--font" 1 ns-handle-switch font)
- ("--internal-border" 1 ns-handle-numeric-switch internal-border-width)
+ ("--name" 1 x-handle-name-switch)
+ ("--title" 1 x-handle-switch title)
+ ("--reverse-video" 0 x-handle-switch reverse t)
+ ("--font" 1 x-handle-switch font)
+ ("--internal-border" 1 x-handle-numeric-switch internal-border-width)
;; ("--geometry" 1 ns-handle-geometry)
- ("--foreground-color" 1 ns-handle-switch foreground-color)
- ("--background-color" 1 ns-handle-switch background-color)
- ("--mouse-color" 1 ns-handle-switch mouse-color)
- ("--icon-type" 0 ns-handle-switch icon-type t)
- ("--iconic" 0 ns-handle-iconic)
+ ("--foreground-color" 1 x-handle-switch foreground-color)
+ ("--background-color" 1 x-handle-switch background-color)
+ ("--mouse-color" 1 x-handle-switch mouse-color)
+ ("--icon-type" 0 x-handle-switch icon-type t)
+ ("--iconic" 0 x-handle-iconic)
;; ("--xrm" 1 ns-handle-xrm-switch)
- ("--cursor-color" 1 ns-handle-switch cursor-color)
- ("--vertical-scroll-bars" 0 ns-handle-switch vertical-scroll-bars t)
- ("--border-color" 1 ns-handle-switch border-width))
+ ("--cursor-color" 1 x-handle-switch cursor-color)
+ ("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t)
+ ("--border-color" 1 x-handle-switch border-width))
"Alist of NS options.
Each element has the form
(NAME NUMARGS HANDLER FRAME-PARAM VALUE)
Setting `init-file-user' does not prevent Emacs from loading
`site-start.el'. The only way to do that is to use `--no-site-file'.")
-(defcustom site-run-file "site-start"
+(defcustom site-run-file (purecopy "site-start")
"File containing site-wide run-time initializations.
This file is loaded at run-time before `~/.emacs'. It contains inits
that need to be in place for the entire site, but which, due to their
:type '(choice (const :tag "none" nil) string)
:group 'initialization
:initialize 'custom-initialize-default
- :set '(lambda (variable value)
+ :set (lambda (variable value)
(error "Customizing `site-run-file' does not work")))
(defcustom mail-host-address nil
string)
:group 'auto-save)
-(defvar emacs-quick-startup nil)
-
(defvar emacs-basic-display nil)
(defvar init-file-debug nil)
(defvar pure-space-overflow nil
"Non-nil if building Emacs overflowed pure space.")
-(defvar pure-space-overflow-message "\
+(defvar pure-space-overflow-message (purecopy "\
Warning Warning!!! Pure space overflow !!!Warning Warning
-\(See the node Pure Storage in the Lisp manual for details.)\n")
-
-(defvar tutorial-directory nil
- "Directory containing the Emacs TUTORIAL files.")
+\(See the node Pure Storage in the Lisp manual for details.)\n"))
-;; Get correct value in a dumped, installed Emacs.
-(eval-at-startup
- (setq tutorial-directory (file-name-as-directory
- (expand-file-name "tutorials" data-directory))))
+(defcustom tutorial-directory
+ (file-name-as-directory (expand-file-name "tutorials" data-directory))
+ "Directory containing the Emacs TUTORIAL files."
+ :group 'installation
+ :type 'directory
+ :initialize 'custom-initialize-delay)
(defun normal-top-level-add-subdirs-to-load-path ()
"Add all subdirectories of current directory to `load-path'.
(default-directory this-dir)
(canonicalized (if (fboundp 'untranslated-canonical-name)
(untranslated-canonical-name this-dir))))
- ;; The Windows version doesn't report meaningful inode
- ;; numbers, so use the canonicalized absolute file name of the
- ;; directory instead.
+ ;; The Windows version doesn't report meaningful inode numbers, so
+ ;; use the canonicalized absolute file name of the directory instead.
(setq attrs (or canonicalized
(nthcdr 10 (file-attributes this-dir))))
(unless (member attrs normal-top-level-add-subdirs-inode-list)
(push attrs normal-top-level-add-subdirs-inode-list)
(dolist (file contents)
- ;; The lower-case variants of RCS and CVS are for DOS/Windows.
- (unless (member file '("." ".." "RCS" "CVS" "rcs" "cvs"))
- (when (and (string-match "\\`[[:alnum:]]" file)
- ;; Avoid doing a `stat' when it isn't necessary
- ;; because that can cause trouble when an NFS server
- ;; is down.
- (not (string-match "\\.elc?\\'" file))
- (file-directory-p file))
- (let ((expanded (expand-file-name file)))
- (unless (file-exists-p (expand-file-name ".nosearch"
- expanded))
- (setq pending (nconc pending (list expanded)))))))))))
+ (and (string-match "\\`[[:alnum:]]" file)
+ ;; The lower-case variants of RCS and CVS are for DOS/Windows.
+ (not (member file '("RCS" "CVS" "rcs" "cvs")))
+ ;; Avoid doing a `stat' when it isn't necessary because
+ ;; that can cause trouble when an NFS server is down.
+ (not (string-match "\\.elc?\\'" file))
+ (file-directory-p file)
+ (let ((expanded (expand-file-name file)))
+ (or (file-exists-p (expand-file-name ".nosearch" expanded))
+ (setq pending (nconc pending (list expanded))))))))))
(normal-top-level-add-to-load-path (cdr (nreverse dirs)))))
-;; This function is called from a subdirs.el file.
-;; It assumes that default-directory is the directory
-;; in which the subdirs.el file exists,
-;; and it adds to load-path the subdirs of that directory
-;; as specified in DIRS. Normally the elements of DIRS are relative.
(defun normal-top-level-add-to-load-path (dirs)
+ "This function is called from a subdirs.el file.
+It assumes that `default-directory' is the directory in which the
+subdirs.el file exists, and it adds to `load-path' the subdirs of
+that directory as specified in DIRS. Normally the elements of
+DIRS are relative."
(let ((tail load-path)
(thisdir (directory-file-name default-directory)))
(while (and tail
;; `user-full-name' is now known; reset its standard-value here.
(put 'user-full-name 'standard-value
(list (default-value 'user-full-name)))
- ;; For root, preserve owner and group when editing files.
- (if (equal (user-uid) 0)
- (setq backup-by-copying-when-mismatch t))
;; 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,
(delete (concat "PWD=" pwd)
process-environment)))))
(setq default-directory (abbreviate-file-name default-directory))
- (let ((menubar-bindings-done nil)
- (old-face-font-rescale-alist face-font-rescale-alist))
+ (let ((old-face-font-rescale-alist face-font-rescale-alist))
(unwind-protect
(command-line)
;; Do this again, in case .emacs defined more abbreviations.
(if (fboundp 'font-menu-add-default)
(font-menu-add-default))
(and window-setup-hook
- (run-hooks 'window-setup-hook))
- (or menubar-bindings-done
- (if (display-popup-menus-p)
- (precompute-menubar-bindings)))))
+ (run-hooks 'window-setup-hook))))
;; Subprocesses of Emacs do not have direct access to the terminal, so
;; unless told otherwise they should only assume a dumb terminal.
;; We are careful to do it late (after term-setup-hook), although the
(delete display process-environment)))))
;; Precompute the keyboard equivalents in the menu bar items.
-(defun precompute-menubar-bindings ()
- (let ((submap (lookup-key global-map [menu-bar])))
- (while submap
- (and (consp (car submap))
- (symbolp (car (car submap)))
- (stringp (car-safe (cdr (car submap))))
- (keymapp (cdr (cdr (car submap))))
- (progn
- (x-popup-menu nil (cdr (cdr (car submap))))
- (if purify-flag
- (garbage-collect))))
- (setq submap (cdr submap))))
- (setq define-key-rebound-commands t))
-
;; Command-line options supported by tty's:
(defconst tty-long-option-alist
'(("--name" . "-name")
and initialize the window system environment to prepare for
opening the first frame (e.g. open a connection to an X server).")
-;; Handle the X-like command-line arguments "-fg", "-bg", "-name", etc.
(defun tty-handle-args (args)
+ "Handle the X-like command-line arguments \"-fg\", \"-bg\", \"-name\", etc."
(let (rest)
(message "%S" args)
(while (and args
after-init-time nil
command-line-default-directory default-directory)
- ;; Choose a reasonable location for temporary files.
- (custom-reevaluate-setting 'temporary-file-directory)
- (custom-reevaluate-setting 'small-temporary-file-directory)
- (custom-reevaluate-setting 'auto-save-file-name-transforms)
+ ;; Force recomputation, in case it was computed during the dump.
+ (setq abbreviated-home-dir nil)
;; See if we should import version-control from the environment variable.
(let ((vc (getenv "VERSION_CONTROL")))
(setq eol-mnemonic-dos "(DOS)"
eol-mnemonic-mac "(Mac)")))
- ;; Make sure window system's init file was loaded in loadup.el if
- ;; using a window system.
- (condition-case error
- (unless noninteractive
- (if (and initial-window-system
- (not (featurep
- (intern
- (concat (symbol-name initial-window-system) "-win")))))
- (error "Unsupported window system `%s'" initial-window-system))
- ;; Process window-system specific command line parameters.
- (setq command-line-args
- (funcall
- (or (cdr (assq initial-window-system handle-args-function-alist))
- (error "Unsupported window system `%s'" initial-window-system))
- command-line-args))
- ;; Initialize the window system. (Open connection, etc.)
- (funcall
- (or (cdr (assq initial-window-system window-system-initialization-alist))
- (error "Unsupported window system `%s'" initial-window-system))))
- ;; If there was an error, print the error message and exit.
- (error
- (princ
- (if (eq (car error) 'error)
- (apply 'concat (cdr error))
- (if (memq 'file-error (get (car error) 'error-conditions))
- (format "%s: %s"
- (nth 1 error)
- (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))
- (cdr error) ", "))))
- 'external-debugging-output)
- (terpri 'external-debugging-output)
- (setq initial-window-system nil)
- (kill-emacs)))
-
(set-locale-environment nil)
;; Convert preloaded file names in load-history to absolute.
(pop args)))
(let ((done nil)
- (args (cdr command-line-args)))
+ (args (cdr command-line-args))
+ display-arg)
;; Figure out which user's init file to load,
;; either from the environment or from the options.
argi (match-string 1 argi)))
(when (string-match "\\`--." orig-argi)
(let ((completion (try-completion argi longopts)))
- (if (eq completion t)
- (setq argi (substring argi 1))
- (if (stringp completion)
- (let ((elt (assoc completion longopts)))
- (or elt
- (error "Option `%s' is ambiguous" argi))
- (setq argi (substring (car elt) 1)))
- (setq argval nil
- argi orig-argi)))))
+ (cond ((eq completion t)
+ (setq argi (substring argi 1)))
+ ((stringp completion)
+ (let ((elt (assoc completion longopts)))
+ (unless elt
+ (error "Option `%s' is ambiguous" argi))
+ (setq argi (substring (car elt) 1))))
+ (t
+ (setq argval nil
+ argi orig-argi)))))
(cond
+ ;; The --display arg is handled partly in C, partly in Lisp.
+ ;; When it shows up here, we just put it back to be handled
+ ;; by `command-line-1'.
+ ((member argi '("-d" "-display"))
+ (setq display-arg (list argi (pop args))))
((member argi '("-Q" "-quick"))
(setq init-file-user nil
site-run-file nil
- emacs-quick-startup t))
+ inhibit-x-resources t))
((member argi '("-D" "-basic-display"))
(setq no-blinking-cursor t
emacs-basic-display t)
(setq init-file-debug t))
((equal argi "-iconic")
(push '(visibility . icon) initial-frame-alist))
- ((member argi '("-icon-type" "-i" "-itype"))
- (push '(icon-type . t) default-frame-alist))
((member argi '("-nbc" "-no-blinking-cursor"))
(setq no-blinking-cursor t))
;; Push the popped arg back on the list of arguments.
(and argval
(error "Option `%s' doesn't allow an argument" argi))))
+ ;; Re-attach the --display arg.
+ (and display-arg (setq args (append display-arg args)))
+
;; Re-attach the program name to the front of the arg list.
(and command-line-args
(setcdr command-line-args args)))
+ ;; Make sure window system's init file was loaded in loadup.el if
+ ;; using a window system.
+ ;; Initialize the window-system only after processing the command-line
+ ;; args so that -Q can influence this initialization.
+ (condition-case error
+ (unless noninteractive
+ (if (and initial-window-system
+ (not (featurep
+ (intern
+ (concat (symbol-name initial-window-system) "-win")))))
+ (error "Unsupported window system `%s'" initial-window-system))
+ ;; Process window-system specific command line parameters.
+ (setq command-line-args
+ (funcall
+ (or (cdr (assq initial-window-system handle-args-function-alist))
+ (error "Unsupported window system `%s'" initial-window-system))
+ command-line-args))
+ ;; Initialize the window system. (Open connection, etc.)
+ (funcall
+ (or (cdr (assq initial-window-system window-system-initialization-alist))
+ (error "Unsupported window system `%s'" initial-window-system))))
+ ;; If there was an error, print the error message and exit.
+ (error
+ (princ
+ (if (eq (car error) 'error)
+ (apply 'concat (cdr error))
+ (if (memq 'file-error (get (car error) 'error-conditions))
+ (format "%s: %s"
+ (nth 1 error)
+ (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))
+ (cdr error) ", "))))
+ 'external-debugging-output)
+ (terpri 'external-debugging-output)
+ (setq initial-window-system nil)
+ (kill-emacs)))
+
(run-hooks 'before-init-hook)
- ;; Under X Window, this creates the X frame and deletes the terminal frame.
+ ;; Under X, this creates the X frame and deletes the terminal frame.
(unless (daemonp)
+
+ ;; If X resources are available, use them to initialize the values
+ ;; of `tool-bar-mode' and `menu-bar-mode', as well as the value of
+ ;; `no-blinking-cursor' and the `cursor' face.
+ (cond
+ ((or noninteractive emacs-basic-display)
+ (setq menu-bar-mode nil
+ tool-bar-mode nil
+ no-blinking-cursor t))
+ ((memq initial-window-system '(x w32 ns))
+ (let ((no-vals '("no" "off" "false" "0")))
+ (if (member (x-get-resource "menuBar" "MenuBar") no-vals)
+ (setq menu-bar-mode nil))
+ (if (member (x-get-resource "toolBar" "ToolBar") no-vals)
+ (setq tool-bar-mode nil))
+ (if (member (x-get-resource "cursorBlink" "CursorBlink")
+ no-vals)
+ (setq no-blinking-cursor t)))
+ ;; If the cursorColor X resource exists, alter the `cursor' face
+ ;; spec, but mark it as changed outside of Customize.
+ (let ((color (x-get-resource "cursorColor" "CursorColor")))
+ (when color
+ (face-spec-set 'cursor `((t (:background ,color))))
+ (put 'cursor 'face-modified t)))))
(frame-initialize))
+ (when (fboundp 'x-create-frame)
+ ;; Set up the tool-bar (even in tty frames, since Emacs might open a
+ ;; graphical frame later).
+ (unless noninteractive
+ (tool-bar-setup)))
+
;; Turn off blinking cursor if so specified in X resources. This is here
;; only because all other settings of no-blinking-cursor are here.
(unless (or noninteractive
'("off" "false")))))
(setq no-blinking-cursor t))
- ;; If frame was created with a menu bar, set menu-bar-mode on.
- (unless (or noninteractive
- emacs-basic-display
- (and (memq initial-window-system '(x w32))
- (<= (frame-parameter nil 'menu-bar-lines) 0)))
- (menu-bar-mode 1))
-
- (unless (or noninteractive (not (fboundp 'tool-bar-mode)))
- ;; Set up the tool-bar. Do this even in tty frames, so that there
- ;; is a tool-bar if Emacs later opens a graphical frame.
- (if (or emacs-basic-display
- (and (numberp (frame-parameter nil 'tool-bar-lines))
- (<= (frame-parameter nil 'tool-bar-lines) 0)))
- ;; On a graphical display with the toolbar disabled via X
- ;; resources, set up the toolbar without enabling it.
- (tool-bar-setup)
- ;; Otherwise, enable tool-bar-mode.
- (tool-bar-mode 1)))
-
- ;; Can't do this init in defcustom because the relevant variables
- ;; are not set.
- (custom-reevaluate-setting 'blink-cursor-mode)
- (custom-reevaluate-setting 'tooltip-mode)
- (custom-reevaluate-setting 'global-font-lock-mode)
- (custom-reevaluate-setting 'mouse-wheel-down-event)
- (custom-reevaluate-setting 'mouse-wheel-up-event)
- (custom-reevaluate-setting 'file-name-shadow-mode)
- (custom-reevaluate-setting 'send-mail-function)
- (custom-reevaluate-setting 'focus-follows-mouse)
- (custom-reevaluate-setting 'global-auto-composition-mode)
- (custom-reevaluate-setting 'transient-mark-mode)
- (custom-reevaluate-setting 'auto-encryption-mode)
+ ;; Re-evaluate predefined variables whose initial value depends on
+ ;; the runtime context.
+ (mapc 'custom-reevaluate-setting
+ ;; Initialize them in the same order they were loaded, in case there
+ ;; are dependencies between them.
+ (prog1 (nreverse custom-delayed-init-variables)
+ (setq custom-delayed-init-variables nil)))
(normal-erase-is-backspace-setup-frame)
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))
+ (orig-enable-multibyte (default-value 'enable-multibyte-characters)))
(let ((debug-on-error debug-on-error-initial)
;; This function actually reads the init files.
(inner
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))
+ (unless (or (default-value 'enable-multibyte-characters)
+ (eq orig-enable-multibyte (default-value
+ '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
(eq face-ignored-fonts old-face-ignored-fonts))
(clear-face-cache)))
+ ;; If any package directory exists, initialize the package system.
+ (and user-init-file
+ package-enable-at-startup
+ (catch 'package-dir-found
+ (let (dirs)
+ (if (boundp 'package-directory-list)
+ (setq dirs package-directory-list)
+ (dolist (f load-path)
+ (and (stringp f)
+ (equal (file-name-nondirectory f) "site-lisp")
+ (push (expand-file-name "elpa" f) dirs))))
+ (push (if (boundp 'package-user-dir)
+ package-user-dir
+ (locate-user-emacs-file "elpa"))
+ dirs)
+ (dolist (dir dirs)
+ (when (file-directory-p dir)
+ (dolist (subdir (directory-files dir))
+ (when (and (file-directory-p (expand-file-name subdir dir))
+ ;; package-subdirectory-regexp from package.el
+ (string-match "^\\([^.].*\\)-\\([0-9]+\\(?:[.][0-9]+\\)*\\)$"
+ subdir))
+ (throw 'package-dir-found t)))))))
+ (package-initialize))
+
(setq after-init-time (current-time))
(run-hooks 'after-init-hook)
;; Decode all default-directory.
- (if (and default-enable-multibyte-characters locale-coding-system)
+ (if (and (default-value 'enable-multibyte-characters) locale-coding-system)
(save-excursion
(dolist (elt (buffer-list))
(set-buffer elt)
;;; Fancy splash screen
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar fancy-startup-text
+(defconst fancy-startup-text
'((:face (variable-pitch (:foreground "red"))
"Welcome to "
:link ("GNU Emacs"
Each element in the list should be a list of strings or pairs
`:face FACE', like `fancy-splash-insert' accepts them.")
-(defvar fancy-about-text
+(defconst fancy-about-text
'((:face (variable-pitch (:foreground "red"))
"This is "
:link ("GNU Emacs"
:link ("Emacs Guided Tour"
(lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/"))
"Browse http://www.gnu.org/software/emacs/tour/")
- "\tSee an overview of the many facilities of GNU Emacs"
+ "\tSee an overview of Emacs features at gnu.org"
))
"A list of texts to show in the middle part of the About screen.
Each element in the list should be a list of strings or pairs
(kill-buffer "*GNU Emacs*")))
" ")
(when (or user-init-file custom-file)
- (let ((checked (create-image "\300\300\141\143\067\076\034\030"
- 'xbm t :width 8 :height 8 :background "grey75"
- :foreground "black" :relief -2 :ascent 'center))
- (unchecked (create-image (make-string 8 0)
- 'xbm t :width 8 :height 8 :background "grey75"
- :foreground "black" :relief -2 :ascent 'center)))
+ (let ((checked (create-image "checked.xpm"
+ nil nil :ascent 'center))
+ (unchecked (create-image "unchecked.xpm"
+ nil nil :ascent 'center)))
(insert-button
- " " :on-glyph checked :off-glyph unchecked 'checked nil
- 'display unchecked 'follow-link t
+ " "
+ :on-glyph checked
+ :off-glyph unchecked
+ 'checked nil 'display unchecked 'follow-link t
'action (lambda (button)
(if (overlay-get button 'checked)
(progn (overlay-put button 'checked nil)
- (overlay-put button 'display (overlay-get button :off-glyph))
- (setq startup-screen-inhibit-startup-screen nil))
+ (overlay-put button 'display
+ (overlay-get button :off-glyph))
+ (setq startup-screen-inhibit-startup-screen
+ nil))
(overlay-put button 'checked t)
- (overlay-put button 'display (overlay-get button :on-glyph))
+ (overlay-put button 'display
+ (overlay-get button :on-glyph))
(setq startup-screen-inhibit-startup-screen t)))))
(fancy-splash-insert :face '(variable-pitch (:height 0.9))
" Never show it again.")))))
(select-frame frame)
(switch-to-buffer "*About GNU Emacs*")
(setq buffer-undo-list t
- mode-line-format (propertize "---- %b %-"
- 'face 'mode-line-buffer-id))
+ mode-line-format
+ (concat "----"
+ (propertize "%b" 'face 'mode-line-buffer-id)
+ "%-"))
(let ((inhibit-read-only t))
(erase-buffer)
(if pure-space-overflow
;; If keys have their default meanings,
;; use precomputed string to save lots of time.
- (let ((c-h-accessible
- ;; If normal-erase-is-backspace is used on a tty, there's
- ;; no way to invoke C-h and you have to use F1 instead.
- (or (not (char-table-p keyboard-translate-table))
- (eq (aref keyboard-translate-table ?\C-h) ?\C-h))))
- (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))
- (let ((help (if c-h-accessible "C-h" "<f1>")))
- (insert "
-Get help\t " help " (Hold down CTRL and press h)
-")
- (insert-button "Emacs manual"
- 'action (lambda (button) (info-emacs-manual))
- 'follow-link t)
- (insert " " help " r\t")
- (insert-button "Browse manuals"
- 'action (lambda (button) (Info-directory))
- 'follow-link t)
- (insert "\t " help " i
-")
- (insert-button "Emacs tutorial"
- 'action (lambda (button) (help-with-tutorial))
- 'follow-link t)
- (insert " " help " t\tUndo changes\t C-x u
-")
- (insert-button "Buy manuals"
- 'action (lambda (button) (view-order-manuals))
- 'follow-link t)
- (insert "\t " help " C-m\tExit Emacs\t C-x C-c"))
-
- (insert (format "
-Get help\t %s
-"
- (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"\t \\[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
- "\t \\[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-terminal]"))))
+ (let* ((c-h-accessible
+ ;; If normal-erase-is-backspace is used on a tty, there's
+ ;; no way to invoke C-h and you have to use F1 instead.
+ (or (not (char-table-p keyboard-translate-table))
+ (eq (aref keyboard-translate-table ?\C-h) ?\C-h)))
+ (minor-mode-overriding-map-alist
+ (cons (cons (not c-h-accessible)
+ ;; If C-h can't be invoked, temporarily disable its
+ ;; binding, so where-is uses alternative bindings.
+ (let ((map (make-sparse-keymap)))
+ (define-key map [?\C-h] 'undefined)
+ map))
+ minor-mode-overriding-map-alist)))
+
+ (insert (format "\nGet help\t %s\n"
+ (let ((where (where-is-internal 'help-command nil t)))
+ (cond
+ ((equal where [?\C-h])
+ "C-h (Hold down CTRL and press h)")
+ (where (key-description where))
+ (t "M-x help")))))
+ (insert-button "Emacs manual"
+ 'action (lambda (button) (info-emacs-manual))
+ 'follow-link t)
+ (insert (substitute-command-keys"\t \\[info-emacs-manual]\t"))
+ (insert-button "Browse manuals"
+ 'action (lambda (button) (Info-directory))
+ 'follow-link t)
+ (insert (substitute-command-keys "\t \\[info]\n"))
+ (insert-button "Emacs tutorial"
+ 'action (lambda (button) (help-with-tutorial))
+ 'follow-link t)
+ (insert (substitute-command-keys
+ "\t \\[help-with-tutorial]\tUndo changes\t \\[undo]\n"))
+ (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-terminal]")))
;; Say how to use the menu bar with the keyboard.
(insert "\n")
(let ((buffer (get-buffer-create " *temp*")))
(prog1
(condition-case nil
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(insert-file-contents user-init-file)
(re-search-forward
(concat
first-file-buffer)
(when command-line-args-left
;; We have command args; process them.
- (let ((dir command-line-default-directory)
- tem
+ ;; Note that any local variables in this function affect the
+ ;; ability of -f batch-byte-compile to detect free variables.
+ ;; So we give some of them with common names a cl1- prefix.
+ (let ((cl1-dir command-line-default-directory)
+ cl1-tem
;; This approach loses for "-batch -L DIR --eval "(require foo)",
;; if foo is intended to be found in DIR.
;;
;; 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") ("--execute") ("--no-splash")
- ("--find-file") ("--visit") ("--file") ("--no-desktop"))
- (mapcar (lambda (elt)
- (list (concat "-" (car elt))))
+ (append '("--funcall" "--load" "--insert" "--kill"
+ "--directory" "--eval" "--execute" "--no-splash"
+ "--find-file" "--visit" "--file" "--no-desktop")
+ (mapcar (lambda (elt) (concat "-" (car elt)))
command-switch-alist)))
- (line 0)
- (column 0))
+ (cl1-line 0)
+ (cl1-column 0))
;; Add the long X options to longopts.
(dolist (tem command-line-x-option-alist)
(if (string-match "^--" (car tem))
- (push (list (car tem)) longopts)))
+ (push (car tem) longopts)))
;; Add the long NS options to longopts.
(dolist (tem command-line-ns-option-alist)
(when (string-match "\\`\\(--[^=]*\\)=" argi)
(setq argval (substring argi (match-end 0))
argi (match-string 1 argi)))
- (when (string-match "\\`--." orig-argi)
+ (when (string-match "\\`--?[^-]" orig-argi)
(setq completion (try-completion argi longopts))
(if (eq completion t)
(setq argi (substring argi 1))
(if (stringp completion)
- (let ((elt (assoc completion longopts)))
+ (let ((elt (member completion longopts)))
(or elt
(error "Option `%s' is ambiguous" argi))
(setq argi (substring (car elt) 1)))
argi orig-argi)))))
;; Execute the option.
- (cond ((setq tem (assoc argi command-switch-alist))
+ (cond ((setq cl1-tem (assoc argi command-switch-alist))
(if argval
(let ((command-line-args-left
(cons argval command-line-args-left)))
- (funcall (cdr tem) argi))
- (funcall (cdr tem) argi)))
+ (funcall (cdr cl1-tem) argi))
+ (funcall (cdr cl1-tem) argi)))
((equal argi "-no-splash")
(setq inhibit-startup-screen t))
"-funcall"
"-e")) ; what the source used to say
(setq inhibit-startup-screen t)
- (setq tem (intern (or argval (pop command-line-args-left))))
- (if (commandp tem)
- (command-execute tem)
- (funcall tem)))
+ (setq cl1-tem (intern (or argval (pop command-line-args-left))))
+ (if (commandp cl1-tem)
+ (command-execute cl1-tem)
+ (funcall cl1-tem)))
((member argi '("-eval" "-execute"))
(setq inhibit-startup-screen t)
(eval (read (or argval (pop command-line-args-left)))))
((member argi '("-L" "-directory"))
- (setq tem (expand-file-name
+ (setq cl1-tem (expand-file-name
(command-line-normalize-file-name
(or argval (pop command-line-args-left)))))
- (cond (splice (setcdr splice (cons tem (cdr splice)))
+ (cond (splice (setcdr splice (cons cl1-tem (cdr splice)))
(setq splice (cdr splice)))
- (t (setq load-path (cons tem load-path)
+ (t (setq load-path (cons cl1-tem load-path)
splice load-path))))
((member argi '("-l" "-load"))
((equal argi "-insert")
(setq inhibit-startup-screen t)
- (setq tem (or argval (pop command-line-args-left)))
- (or (stringp tem)
+ (setq cl1-tem (or argval (pop command-line-args-left)))
+ (or (stringp cl1-tem)
(error "File name omitted from `-insert' option"))
- (insert-file-contents (command-line-normalize-file-name tem)))
+ (insert-file-contents (command-line-normalize-file-name cl1-tem)))
((equal argi "-kill")
(kill-emacs t))
(message "\"--no-desktop\" ignored because the Desktop package is not loaded"))
((string-match "^\\+[0-9]+\\'" argi)
- (setq line (string-to-number argi)))
+ (setq cl1-line (string-to-number argi)))
((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi)
- (setq line (string-to-number (match-string 1 argi))
- column (string-to-number (match-string 2 argi))))
+ (setq cl1-line (string-to-number (match-string 1 argi))
+ cl1-column (string-to-number (match-string 2 argi))))
- ((setq tem (assoc argi command-line-x-option-alist))
+ ((setq cl1-tem (assoc orig-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)))
+ (nthcdr (nth 1 cl1-tem) command-line-args-left)))
- ((setq tem (assoc argi command-line-ns-option-alist))
+ ((setq cl1-tem (assoc orig-argi command-line-ns-option-alist))
;; Ignore NS-windows options and their args if not using NS.
(setq command-line-args-left
- (nthcdr (nth 1 tem) command-line-args-left)))
+ (nthcdr (nth 1 cl1-tem) command-line-args-left)))
((member argi '("-find-file" "-file" "-visit"))
(setq inhibit-startup-screen t)
;; An explicit option to specify visiting a file.
- (setq tem (or argval (pop command-line-args-left)))
- (unless (stringp tem)
+ (setq cl1-tem (or argval (pop command-line-args-left)))
+ (unless (stringp cl1-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 tem) dir)))
+ (command-line-normalize-file-name cl1-tem)
+ cl1-dir)))
(if (= file-count 1)
(setq first-file-buffer (find-file file))
(find-file-other-window file)))
- (unless (zerop line)
+ (unless (zerop cl1-line)
(goto-char (point-min))
- (forward-line (1- line)))
- (setq line 0)
- (unless (< column 1)
- (move-to-column (1- column)))
- (setq column 0))
+ (forward-line (1- cl1-line)))
+ (setq cl1-line 0)
+ (unless (< cl1-column 1)
+ (move-to-column (1- cl1-column)))
+ (setq cl1-column 0))
+
+ ;; These command lines now have no effect.
+ ((string-match "\\`--?\\(no-\\)?\\(uni\\|multi\\)byte$" argi)
+ (display-warning 'initialization
+ (format "Ignoring obsolete arg %s" argi)))
((equal argi "--")
(setq just-files t))
(let ((file
(expand-file-name
(command-line-normalize-file-name orig-argi)
- dir)))
+ cl1-dir)))
(cond ((= file-count 1)
(setq first-file-buffer (find-file file)))
(inhibit-startup-screen
(find-file-other-window file))
(t (find-file file))))
- (unless (zerop line)
+ (unless (zerop cl1-line)
(goto-char (point-min))
- (forward-line (1- line)))
- (setq line 0)
- (unless (< column 1)
- (move-to-column (1- column)))
- (setq column 0))))))
+ (forward-line (1- cl1-line)))
+ (setq cl1-line 0)
+ (unless (< cl1-column 1)
+ (move-to-column (1- cl1-column)))
+ (setq cl1-column 0))))))
;; In unusual circumstances, the execution of Lisp code due
;; to command-line options can cause the last visible frame
;; to be deleted. In this case, kill emacs to avoid an
(if (or inhibit-startup-screen
initial-buffer-choice
noninteractive
- emacs-quick-startup)
+ inhibit-x-resources)
;; Not displaying a startup screen. If 3 or more files
;; visited, and not all visible, show user what they all are.
;; However, /// at the beginning is supposed to mean just /, not //.
(if (string-match "^///+" file)
(setq file (replace-match "/" t t file)))
+ (and (memq system-type '(ms-dos windows-nt))
+ (string-match "^[A-Za-z]:\\(\\\\[\\\\/]\\)" file) ; C:\/ or C:\\
+ (setq file (replace-match "/" t t file 1)))
(while (string-match "//+" file 1)
(setq file (replace-match "/" t t file)))
file))
-;; arch-tag: 7e294698-244d-4758-984b-4047f887a5db
;;; startup.el ends here
HCoop / bpt / emacs.git / blobdiff