1;;; startup.el --- process Emacs shell arguments 2 3;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 4;; 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Maintainer: FSF 7;; Keywords: internal 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs is free software; you can redistribute it and/or modify 12;; it under the terms of the GNU General Public License as published by 13;; the Free Software Foundation; either version 2, or (at your option) 14;; any later version. 15 16;; GNU Emacs is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20 21;; You should have received a copy of the GNU General Public License 22;; along with GNU Emacs; see the file COPYING. If not, write to the 23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, USA. 25 26;;; Commentary: 27 28;; This file parses the command line and gets Emacs running. Options 29;; on the command line are handled in precedence order. For priorities 30;; see the structure standard_args in the emacs.c file. 31 32;;; Code: 33 34(setq top-level '(normal-top-level)) 35 36(defvar command-line-processed nil 37 "Non-nil once command line has been processed.") 38 39(defgroup initialization nil 40 "Emacs start-up procedure." 41 :group 'internal) 42 43(defcustom inhibit-splash-screen nil 44 "Non-nil inhibits the startup screen. 45It also inhibits display of the initial message in the `*scratch*' buffer. 46 47This is for use in your personal init file (but NOT site-start.el), once 48you are familiar with the contents of the startup screen." 49 :type 'boolean 50 :group 'initialization) 51 52(defvaralias 'inhibit-startup-message 'inhibit-splash-screen) 53 54(defcustom inhibit-startup-echo-area-message nil 55 "*Non-nil inhibits the initial startup echo area message. 56Setting this variable takes effect 57only if you do it with the customization buffer 58or if your `.emacs' file contains a line of this form: 59 (setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\") 60If your `.emacs' file is byte-compiled, use the following form instead: 61 (eval '(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\")) 62Thus, someone else using a copy of your `.emacs' file will see 63the startup message unless he personally acts to inhibit it." 64 :type '(choice (const :tag "Don't inhibit") 65 (string :tag "Enter your user name, to inhibit")) 66 :group 'initialization) 67 68(defcustom inhibit-default-init nil 69 "*Non-nil inhibits loading the `default' library." 70 :type 'boolean 71 :group 'initialization) 72 73(defcustom inhibit-startup-buffer-menu nil 74 "*Non-nil inhibits display of buffer list when more than 2 files are loaded." 75 :type 'boolean 76 :group 'initialization) 77 78(defvar command-switch-alist nil 79 "Alist of command-line switches. 80Elements look like (SWITCH-STRING . HANDLER-FUNCTION). 81HANDLER-FUNCTION receives the switch string as its sole argument; 82the remaining command-line args are in the variable `command-line-args-left'.") 83 84(defvar command-line-args-left nil 85 "List of command-line args not yet processed.") 86 87(defvar command-line-functions nil ;; lrs 7/31/89 88 "List of functions to process unrecognized command-line arguments. 89Each function should access the dynamically bound variables 90`argi' (the current argument) and `command-line-args-left' (the remaining 91arguments). The function should return non-nil only if it recognizes and 92processes `argi'. If it does so, it may consume successive arguments by 93altering `command-line-args-left' to remove them.") 94 95(defvar command-line-default-directory nil 96 "Default directory to use for command line arguments. 97This is normally copied from `default-directory' when Emacs starts.") 98 99;;; This is here, rather than in x-win.el, so that we can ignore these 100;;; options when we are not using X. 101(defconst command-line-x-option-alist 102 '(("-bw" 1 x-handle-numeric-switch border-width) 103 ("-d" 1 x-handle-display) 104 ("-display" 1 x-handle-display) 105 ("-name" 1 x-handle-name-switch) 106 ("-title" 1 x-handle-switch title) 107 ("-T" 1 x-handle-switch title) 108 ("-r" 0 x-handle-switch reverse t) 109 ("-rv" 0 x-handle-switch reverse t) 110 ("-reverse" 0 x-handle-switch reverse t) 111 ("-reverse-video" 0 x-handle-switch reverse t) 112 ("-fn" 1 x-handle-switch font) 113 ("-font" 1 x-handle-switch font) 114 ("-fs" 0 x-handle-initial-switch fullscreen fullboth) 115 ("-fw" 0 x-handle-initial-switch fullscreen fullwidth) 116 ("-fh" 0 x-handle-initial-switch fullscreen fullheight) 117 ("-ib" 1 x-handle-numeric-switch internal-border-width) 118 ("-g" 1 x-handle-geometry) 119 ("-lsp" 1 x-handle-numeric-switch line-spacing) 120 ("-geometry" 1 x-handle-geometry) 121 ("-fg" 1 x-handle-switch foreground-color) 122 ("-foreground" 1 x-handle-switch foreground-color) 123 ("-bg" 1 x-handle-switch background-color) 124 ("-background" 1 x-handle-switch background-color) 125 ("-ms" 1 x-handle-switch mouse-color) 126 ("-nbi" 0 x-handle-switch icon-type nil) 127 ("-iconic" 0 x-handle-iconic) 128 ("-xrm" 1 x-handle-xrm-switch) 129 ("-cr" 1 x-handle-switch cursor-color) 130 ("-vb" 0 x-handle-switch vertical-scroll-bars t) 131 ("-hb" 0 x-handle-switch horizontal-scroll-bars t) 132 ("-bd" 1 x-handle-switch) 133 ("--border-width" 1 x-handle-numeric-switch border-width) 134 ("--display" 1 x-handle-display) 135 ("--name" 1 x-handle-name-switch) 136 ("--title" 1 x-handle-switch title) 137 ("--reverse-video" 0 x-handle-switch reverse t) 138 ("--font" 1 x-handle-switch font) 139 ("--fullscreen" 0 x-handle-initial-switch fullscreen fullboth) 140 ("--fullwidth" 0 x-handle-initial-switch fullscreen fullwidth) 141 ("--fullheight" 0 x-handle-initial-switch fullscreen fullheight) 142 ("--internal-border" 1 x-handle-numeric-switch internal-border-width) 143 ("--geometry" 1 x-handle-geometry) 144 ("--foreground-color" 1 x-handle-switch foreground-color) 145 ("--background-color" 1 x-handle-switch background-color) 146 ("--mouse-color" 1 x-handle-switch mouse-color) 147 ("--no-bitmap-icon" 0 x-handle-switch icon-type nil) 148 ("--iconic" 0 x-handle-iconic) 149 ("--xrm" 1 x-handle-xrm-switch) 150 ("--cursor-color" 1 x-handle-switch cursor-color) 151 ("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t) 152 ("--line-spacing" 1 x-handle-numeric-switch line-spacing) 153 ("--border-color" 1 x-handle-switch border-color) 154 ("--smid" 1 x-handle-smid)) 155 "Alist of X Windows options. 156Each element has the form 157 (NAME NUMARGS HANDLER FRAME-PARAM VALUE) 158where NAME is the option name string, NUMARGS is the number of arguments 159that the option accepts, HANDLER is a function to call to handle the option. 160FRAME-PARAM (optional) is the frame parameter this option specifies, 161and VALUE is the value which is given to that frame parameter 162\(most options use the argument for this, so VALUE is not present).") 163 164(defvar before-init-hook nil 165 "Normal hook run after handling urgent options but before loading init files.") 166 167(defvar after-init-hook nil 168 "Normal hook run after loading the init files, `~/.emacs' and `default.el'. 169There is no `condition-case' around the running of these functions; 170therefore, if you set `debug-on-error' non-nil in `.emacs', 171an error in one of these functions will invoke the debugger.") 172 173(defvar emacs-startup-hook nil 174 "Normal hook run after loading init files and handling the command line.") 175 176(defvar term-setup-hook nil 177 "Normal hook run after loading terminal-specific Lisp code. 178It also follows `emacs-startup-hook'. This hook exists for users to set, 179so as to override the definitions made by the terminal-specific file. 180Emacs never sets this variable itself.") 181 182(defvar inhibit-startup-hooks nil 183 "Non-nil means don't run `term-setup-hook' and `emacs-startup-hook'. 184This is because we already did so.") 185 186(defvar keyboard-type nil 187 "The brand of keyboard you are using. 188This variable is used to define the proper function and keypad 189keys for use under X. It is used in a fashion analogous to the 190environment variable TERM.") 191 192(defvar window-setup-hook nil 193 "Normal hook run to initialize window system display. 194Emacs runs this hook after processing the command line arguments and loading 195the user's init file.") 196 197(defcustom initial-major-mode 'lisp-interaction-mode 198 "Major mode command symbol to use for the initial `*scratch*' buffer." 199 :type 'function 200 :group 'initialization) 201 202(defvar init-file-user nil 203 "Identity of user whose `.emacs' file is or was read. 204The value is nil if `-q' or `--no-init-file' was specified, 205meaning do not load any init file. 206 207Otherwise, the value may be an empty string, meaning 208use the init file for the user who originally logged in, 209or it may be a string containing a user's name meaning 210use that person's init file. 211 212In either of the latter cases, `(concat \"~\" init-file-user \"/\")' 213evaluates to the name of the directory where the `.emacs' file was 214looked for. 215 216Setting `init-file-user' does not prevent Emacs from loading 217`site-start.el'. The only way to do that is to use `--no-site-file'.") 218 219(defcustom site-run-file "site-start" 220 "File containing site-wide run-time initializations. 221This file is loaded at run-time before `~/.emacs'. It contains inits 222that need to be in place for the entire site, but which, due to their 223higher incidence of change, don't make sense to load into Emacs's 224dumped image. Thus, the run-time load order is: 1. file described in 225this variable, if non-nil; 2. `~/.emacs'; 3. `default.el'. 226 227Don't use the `site-start.el' file for things some users may not like. 228Put them in `default.el' instead, so that users can more easily 229override them. Users can prevent loading `default.el' with the `-q' 230option or by setting `inhibit-default-init' in their own init files, 231but inhibiting `site-start.el' requires `--no-site-file', which 232is less convenient. 233 234This variable is defined for customization so as to make 235it visible in the relevant context. However, actually customizing it 236is not allowed, since it would not work anyway. The only way to set 237this variable usefully is to set it while building and dumping Emacs." 238 :type '(choice (const :tag "none" nil) string) 239 :group 'initialization 240 :initialize 'custom-initialize-default 241 :set '(lambda (variable value) 242 (error "Customizing `site-run-file' does not work"))) 243 244(defcustom mail-host-address nil 245 "*Name of this machine, for purposes of naming users." 246 :type '(choice (const nil) string) 247 :group 'mail) 248 249(defcustom user-mail-address (if command-line-processed 250 (or (getenv "EMAIL") 251 (concat (user-login-name) "@" 252 (or mail-host-address 253 (system-name)))) 254 ;; Empty string means "not set yet". 255 "") 256 "*Full mailing address of this user. 257This is initialized with environment variable `EMAIL' or, as a 258fallback, using `mail-host-address'. This is done after your 259init file is read, in case it sets `mail-host-address'." 260 :type 'string 261 :group 'mail) 262 263(defcustom auto-save-list-file-prefix 264 (cond ((eq system-type 'ms-dos) 265 ;; MS-DOS cannot have initial dot, and allows only 8.3 names 266 "~/_emacs.d/auto-save.list/_s") 267 (t 268 "~/.emacs.d/auto-save-list/.saves-")) 269 "Prefix for generating `auto-save-list-file-name'. 270This is used after reading your `.emacs' file to initialize 271`auto-save-list-file-name', by appending Emacs's pid and the system name, 272if you have not already set `auto-save-list-file-name' yourself. 273Directories in the prefix will be created if necessary. 274Set this to nil if you want to prevent `auto-save-list-file-name' 275from being initialized." 276 :type '(choice (const :tag "Don't record a session's auto save list" nil) 277 string) 278 :group 'auto-save) 279 280(defvar emacs-quick-startup nil) 281 282(defvar emacs-basic-display nil) 283 284(defvar init-file-debug nil) 285 286(defvar init-file-had-error nil 287 "Non-nil if there was an error loading the user's init file.") 288 289(defvar normal-top-level-add-subdirs-inode-list nil) 290 291(defvar no-blinking-cursor nil) 292 293(defvar default-frame-background-mode) 294 295(defvar pure-space-overflow nil 296 "Non-nil if building Emacs overflowed pure space.") 297 298(defun normal-top-level-add-subdirs-to-load-path () 299 "Add all subdirectories of current directory to `load-path'. 300More precisely, this uses only the subdirectories whose names 301start with letters or digits; it excludes any subdirectory named `RCS' 302or `CVS', and any subdirectory that contains a file named `.nosearch'." 303 (let (dirs 304 attrs 305 (pending (list default-directory))) 306 ;; This loop does a breadth-first tree walk on DIR's subtree, 307 ;; putting each subdir into DIRS as its contents are examined. 308 (while pending 309 (push (pop pending) dirs) 310 (let* ((this-dir (car dirs)) 311 (contents (directory-files this-dir)) 312 (default-directory this-dir) 313 (canonicalized (if (fboundp 'untranslated-canonical-name) 314 (untranslated-canonical-name this-dir)))) 315 ;; The Windows version doesn't report meaningful inode 316 ;; numbers, so use the canonicalized absolute file name of the 317 ;; directory instead. 318 (setq attrs (or canonicalized 319 (nthcdr 10 (file-attributes this-dir)))) 320 (unless (member attrs normal-top-level-add-subdirs-inode-list) 321 (push attrs normal-top-level-add-subdirs-inode-list) 322 (dolist (file contents) 323 ;; The lower-case variants of RCS and CVS are for DOS/Windows. 324 (unless (member file '("." ".." "RCS" "CVS" "rcs" "cvs")) 325 (when (and (string-match "\\`[[:alnum:]]" file) 326 ;; Avoid doing a `stat' when it isn't necessary 327 ;; because that can cause trouble when an NFS server 328 ;; is down. 329 (not (string-match "\\.elc?\\'" file)) 330 (file-directory-p file)) 331 (let ((expanded (expand-file-name file))) 332 (unless (file-exists-p (expand-file-name ".nosearch" 333 expanded)) 334 (setq pending (nconc pending (list expanded))))))))))) 335 (normal-top-level-add-to-load-path (cdr (nreverse dirs))))) 336 337;; This function is called from a subdirs.el file. 338;; It assumes that default-directory is the directory 339;; in which the subdirs.el file exists, 340;; and it adds to load-path the subdirs of that directory 341;; as specified in DIRS. Normally the elements of DIRS are relative. 342(defun normal-top-level-add-to-load-path (dirs) 343 (let ((tail load-path) 344 (thisdir (directory-file-name default-directory))) 345 (while (and tail 346 ;;Don't go all the way to the nil terminator. 347 (cdr tail) 348 (not (equal thisdir (car tail))) 349 (not (and (memq system-type '(ms-dos windows-nt)) 350 (equal (downcase thisdir) (downcase (car tail)))))) 351 (setq tail (cdr tail))) 352 ;;Splice the new section in. 353 (when tail 354 (setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail)))))) 355 356(defun normal-top-level () 357 (if command-line-processed 358 (message "Back to top level.") 359 (setq command-line-processed t) 360 ;; Give *Messages* the same default-directory as *scratch*, 361 ;; just to keep things predictable. 362 (let ((dir default-directory)) 363 (with-current-buffer "*Messages*" 364 (setq default-directory dir))) 365 ;; `user-full-name' is now known; reset its standard-value here. 366 (put 'user-full-name 'standard-value 367 (list (default-value 'user-full-name))) 368 ;; For root, preserve owner and group when editing files. 369 (if (equal (user-uid) 0) 370 (setq backup-by-copying-when-mismatch t)) 371 ;; Look in each dir in load-path for a subdirs.el file. 372 ;; If we find one, load it, which will add the appropriate subdirs 373 ;; of that dir into load-path, 374 ;; Look for a leim-list.el file too. Loading it will register 375 ;; available input methods. 376 (let ((tail load-path) dir) 377 (while tail 378 (setq dir (car tail)) 379 (let ((default-directory dir)) 380 (load (expand-file-name "subdirs.el") t t t)) 381 (let ((default-directory dir)) 382 (load (expand-file-name "leim-list.el") t t t)) 383 ;; We don't use a dolist loop and we put this "setq-cdr" command at 384 ;; the end, because the subdirs.el files may add elements to the end 385 ;; of load-path and we want to take it into account. 386 (setq tail (cdr tail)))) 387 (unless (eq system-type 'vax-vms) 388 ;; If the PWD environment variable isn't accurate, delete it. 389 (let ((pwd (getenv "PWD"))) 390 (and (stringp pwd) 391 ;; Use FOO/., so that if FOO is a symlink, file-attributes 392 ;; describes the directory linked to, not FOO itself. 393 (or (equal (file-attributes 394 (concat (file-name-as-directory pwd) ".")) 395 (file-attributes 396 (concat (file-name-as-directory default-directory) 397 "."))) 398 (setq process-environment 399 (delete (concat "PWD=" pwd) 400 process-environment)))))) 401 (setq default-directory (abbreviate-file-name default-directory)) 402 (let ((menubar-bindings-done nil)) 403 (unwind-protect 404 (command-line) 405 ;; Do this again, in case .emacs defined more abbreviations. 406 (setq default-directory (abbreviate-file-name default-directory)) 407 ;; Specify the file for recording all the auto save files of this session. 408 ;; This is used by recover-session. 409 (or auto-save-list-file-name 410 (and auto-save-list-file-prefix 411 (setq auto-save-list-file-name 412 ;; Under MS-DOS our PID is almost always reused between 413 ;; Emacs invocations. We need something more unique. 414 (cond ((eq system-type 'ms-dos) 415 ;; We are going to access the auto-save 416 ;; directory, so make sure it exists. 417 (make-directory 418 (file-name-directory auto-save-list-file-prefix) 419 t) 420 (concat 421 (make-temp-name 422 (expand-file-name 423 auto-save-list-file-prefix)) 424 "~")) 425 (t 426 (expand-file-name 427 (format "%s%d-%s~" 428 auto-save-list-file-prefix 429 (emacs-pid) 430 (system-name)))))))) 431 (unless inhibit-startup-hooks 432 (run-hooks 'emacs-startup-hook) 433 (and term-setup-hook 434 (run-hooks 'term-setup-hook))) 435 436 ;; Don't do this if we failed to create the initial frame, 437 ;; for instance due to a dense colormap. 438 (when (or frame-initial-frame 439 ;; If frame-initial-frame has no meaning, do this anyway. 440 (not (and window-system 441 (not noninteractive) 442 (not (eq window-system 'pc))))) 443 ;; Modify the initial frame based on what .emacs puts into 444 ;; ...-frame-alist. 445 (if (fboundp 'frame-notice-user-settings) 446 (frame-notice-user-settings)) 447 (if (fboundp 'frame-set-background-mode) 448 ;; Set the faces for the initial background mode even if 449 ;; frame-notice-user-settings didn't (such as on a tty). 450 ;; frame-set-background-mode is idempotent, so it won't 451 ;; cause any harm if it's already been done. 452 (let ((frame (selected-frame)) 453 term) 454 (when (and (null window-system) 455 ;; Don't override default set by files in lisp/term. 456 (null default-frame-background-mode) 457 (let ((bg (frame-parameter frame 'background-color))) 458 (or (null bg) 459 (member bg '(unspecified "unspecified-bg" 460 "unspecified-fg"))))) 461 462 (setq term (getenv "TERM")) 463 ;; Some files in lisp/term do a better job with the 464 ;; background mode, but we leave this here anyway, in 465 ;; case they remove those files. 466 (if (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)" 467 term) 468 (setq default-frame-background-mode 'light))) 469 (frame-set-background-mode (selected-frame))))) 470 471 ;; Now we know the user's default font, so add it to the menu. 472 (if (fboundp 'font-menu-add-default) 473 (font-menu-add-default)) 474 (and window-setup-hook 475 (run-hooks 'window-setup-hook)) 476 (or menubar-bindings-done 477 (if (display-popup-menus-p) 478 (precompute-menubar-bindings))))))) 479 480;; Precompute the keyboard equivalents in the menu bar items. 481(defun precompute-menubar-bindings () 482 (let ((submap (lookup-key global-map [menu-bar]))) 483 (while submap 484 (and (consp (car submap)) 485 (symbolp (car (car submap))) 486 (stringp (car-safe (cdr (car submap)))) 487 (keymapp (cdr (cdr (car submap)))) 488 (progn 489 (x-popup-menu nil (cdr (cdr (car submap)))) 490 (if purify-flag 491 (garbage-collect)))) 492 (setq submap (cdr submap)))) 493 (setq define-key-rebound-commands t)) 494 495;; Command-line options supported by tty's: 496(defconst tty-long-option-alist 497 '(("--name" . "-name") 498 ("--title" . "-T") 499 ("--reverse-video" . "-reverse") 500 ("--foreground-color" . "-fg") 501 ("--background-color" . "-bg") 502 ("--color" . "-color"))) 503 504(defconst tool-bar-images-pixel-height 24 505 "Height in pixels of images in the tool bar.") 506 507(defvar tool-bar-originally-present nil 508 "Non-nil if tool-bars are present before user and site init files are read.") 509 510;; Handle the X-like command-line arguments "-fg", "-bg", "-name", etc. 511(defun tty-handle-args (args) 512 (let (rest) 513 (message "%S" args) 514 (while (and args 515 (not (equal (car args) "--"))) 516 (let* ((argi (pop args)) 517 (orig-argi argi) 518 argval completion) 519 ;; Check for long options with attached arguments 520 ;; and separate out the attached option argument into argval. 521 (when (string-match "^\\(--[^=]*\\)=" argi) 522 (setq argval (substring argi (match-end 0)) 523 argi (match-string 1 argi))) 524 (when (string-match "^--" argi) 525 (setq completion (try-completion argi tty-long-option-alist)) 526 (if (eq completion t) 527 ;; Exact match for long option. 528 (setq argi (cdr (assoc argi tty-long-option-alist))) 529 (if (stringp completion) 530 (let ((elt (assoc completion tty-long-option-alist))) 531 ;; Check for abbreviated long option. 532 (or elt 533 (error "Option `%s' is ambiguous" argi)) 534 (setq argi (cdr elt))) 535 ;; Check for a short option. 536 (setq argval nil 537 argi orig-argi)))) 538 (cond ((member argi '("-fg" "-foreground")) 539 (push (cons 'foreground-color (or argval (pop args))) 540 default-frame-alist)) 541 ((member argi '("-bg" "-background")) 542 (push (cons 'background-color (or argval (pop args))) 543 default-frame-alist)) 544 ((member argi '("-T" "-name")) 545 (unless argval (setq argval (pop args))) 546 (push (cons 'title 547 (if (stringp argval) 548 argval 549 (let ((case-fold-search t) 550 i) 551 (setq argval (invocation-name)) 552 553 ;; Change any . or * characters in name to 554 ;; hyphens, so as to emulate behavior on X. 555 (while 556 (setq i (string-match "[.*]" argval)) 557 (aset argval i ?-)) 558 argval))) 559 default-frame-alist)) 560 ((member argi '("-r" "-rv" "-reverse")) 561 (push '(reverse . t) 562 default-frame-alist)) 563 ((equal argi "-color") 564 (unless argval (setq argval 8)) ; default --color means 8 ANSI colors 565 (push (cons 'tty-color-mode 566 (cond 567 ((numberp argval) argval) 568 ((string-match "-?[0-9]+" argval) 569 (string-to-number argval)) 570 (t (intern argval)))) 571 default-frame-alist)) 572 (t 573 (push argi rest))))) 574 (nreverse rest))) 575 576(defun command-line () 577 (setq command-line-default-directory default-directory) 578 579 ;; Choose a reasonable location for temporary files. 580 (custom-reevaluate-setting 'temporary-file-directory) 581 (custom-reevaluate-setting 'small-temporary-file-directory) 582 (custom-reevaluate-setting 'auto-save-file-name-transforms) 583 584 ;; See if we should import version-control from the environment variable. 585 (let ((vc (getenv "VERSION_CONTROL"))) 586 (cond ((eq vc nil)) ;don't do anything if not set 587 ((member vc '("t" "numbered")) 588 (setq version-control t)) 589 ((member vc '("nil" "existing")) 590 (setq version-control nil)) 591 ((member vc '("never" "simple")) 592 (setq version-control 'never)))) 593 594 ;;! This has been commented out; I currently find the behavior when 595 ;;! split-window-keep-point is nil disturbing, but if I can get used 596 ;;! to it, then it would be better to eliminate the option. 597 ;;! ;; Choose a good default value for split-window-keep-point. 598 ;;! (setq split-window-keep-point (> baud-rate 2400)) 599 600 ;; Set the default strings to display in mode line for 601 ;; end-of-line formats that aren't native to this platform. 602 (cond 603 ((memq system-type '(ms-dos windows-nt emx)) 604 (setq eol-mnemonic-unix "(Unix)" 605 eol-mnemonic-mac "(Mac)")) 606 ;; Both Mac and Unix EOLs are now "native" on Mac OS so keep the 607 ;; abbreviated strings `/' and `:' set in coding.c for them. 608 ((eq system-type 'macos) 609 (setq eol-mnemonic-dos "(DOS)")) 610 (t ; this is for Unix/GNU/Linux systems 611 (setq eol-mnemonic-dos "(DOS)" 612 eol-mnemonic-mac "(Mac)"))) 613 614 ;; Read window system's init file if using a window system. 615 (condition-case error 616 (if (and window-system (not noninteractive)) 617 (load (concat term-file-prefix 618 (symbol-name window-system) 619 "-win") 620 ;; Every window system should have a startup file; 621 ;; barf if we can't find it. 622 nil t)) 623 ;; If we can't read it, print the error message and exit. 624 (error 625 (princ 626 (if (eq (car error) 'error) 627 (apply 'concat (cdr error)) 628 (if (memq 'file-error (get (car error) 'error-conditions)) 629 (format "%s: %s" 630 (nth 1 error) 631 (mapconcat (lambda (obj) (prin1-to-string obj t)) 632 (cdr (cdr error)) ", ")) 633 (format "%s: %s" 634 (get (car error) 'error-message) 635 (mapconcat (lambda (obj) (prin1-to-string obj t)) 636 (cdr error) ", ")))) 637 'external-debugging-output) 638 (terpri 'external-debugging-output) 639 (setq window-system nil) 640 (kill-emacs))) 641 642 ;; Windowed displays do this inside their *-win.el. 643 (unless (or (display-graphic-p) noninteractive) 644 (setq command-line-args (tty-handle-args command-line-args))) 645 646 (set-locale-environment nil) 647 648 ;; Convert preloaded file names in load-history to absolute. 649 (let ((simple-file-name 650 ;; Look for simple.el or simple.elc and use their directory 651 ;; as the place where all Lisp files live. 652 (locate-file "simple" load-path (get-load-suffixes))) 653 lisp-dir) 654 ;; Don't abort if simple.el cannot be found, but print a warning. 655 (if (null simple-file-name) 656 (progn 657 (princ "Warning: Could not find simple.el nor simple.elc" 658 'external-debugging-output) 659 (terpri 'external-debugging-output)) 660 (setq lisp-dir (file-truename (file-name-directory simple-file-name))) 661 (setq load-history 662 (mapcar (lambda (elt) 663 (if (and (stringp (car elt)) 664 (not (file-name-absolute-p (car elt)))) 665 (cons (concat lisp-dir 666 (car elt)) 667 (cdr elt)) 668 elt)) 669 load-history)))) 670 671 ;; Convert the arguments to Emacs internal representation. 672 (let ((args (cdr command-line-args))) 673 (while args 674 (setcar args 675 (decode-coding-string (car args) locale-coding-system t)) 676 (pop args))) 677 678 (let ((done nil) 679 (args (cdr command-line-args))) 680 681 ;; Figure out which user's init file to load, 682 ;; either from the environment or from the options. 683 (setq init-file-user (if noninteractive nil (user-login-name))) 684 ;; If user has not done su, use current $HOME to find .emacs. 685 (and init-file-user 686 (equal init-file-user (user-real-login-name)) 687 (setq init-file-user "")) 688 689 ;; Process the command-line args, and delete the arguments 690 ;; processed. This is consistent with the way main in emacs.c 691 ;; does things. 692 (while (and (not done) args) 693 (let* ((longopts '(("--no-init-file") ("--no-site-file") ("--debug-init") 694 ("--user") ("--iconic") ("--icon-type") ("--quick") 695 ("--no-blinking-cursor") ("--basic-display"))) 696 (argi (pop args)) 697 (orig-argi argi) 698 argval) 699 ;; Handle --OPTION=VALUE format. 700 (when (string-match "^\\(--[^=]*\\)=" argi) 701 (setq argval (substring argi (match-end 0)) 702 argi (match-string 1 argi))) 703 (unless (equal argi "--") 704 (let ((completion (try-completion argi longopts))) 705 (if (eq completion t) 706 (setq argi (substring argi 1)) 707 (if (stringp completion) 708 (let ((elt (assoc completion longopts))) 709 (or elt 710 (error "Option `%s' is ambiguous" argi)) 711 (setq argi (substring (car elt) 1))) 712 (setq argval nil 713 argi orig-argi))))) 714 (cond 715 ((member argi '("-Q" "-quick")) 716 (setq init-file-user nil 717 site-run-file nil 718 emacs-quick-startup t)) 719 ((member argi '("-D" "-basic-display")) 720 (setq no-blinking-cursor t 721 emacs-basic-display t) 722 (push '(vertical-scroll-bars . nil) initial-frame-alist)) 723 ((member argi '("-q" "-no-init-file")) 724 (setq init-file-user nil)) 725 ((member argi '("-u" "-user")) 726 (setq init-file-user (or argval (pop args)) 727 argval nil)) 728 ((equal argi "-no-site-file") 729 (setq site-run-file nil)) 730 ((equal argi "-debug-init") 731 (setq init-file-debug t)) 732 ((equal argi "-iconic") 733 (push '(visibility . icon) initial-frame-alist)) 734 ((member argi '("-icon-type" "-i" "-itype")) 735 (push '(icon-type . t) default-frame-alist)) 736 ((member argi '("-nbc" "-no-blinking-cursor")) 737 (setq no-blinking-cursor t)) 738 ;; Push the popped arg back on the list of arguments. 739 (t 740 (push argi args) 741 (setq done t))) 742 ;; Was argval set but not used? 743 (and argval 744 (error "Option `%s' doesn't allow an argument" argi)))) 745 746 ;; Re-attach the program name to the front of the arg list. 747 (and command-line-args 748 (setcdr command-line-args args))) 749 750 (run-hooks 'before-init-hook) 751 752 ;; Under X Window, this creates the X frame and deletes the terminal frame. 753 (when (fboundp 'frame-initialize) 754 (frame-initialize)) 755 756 ;; Turn off blinking cursor if so specified in X resources. This is here 757 ;; only because all other settings of no-blinking-cursor are here. 758 (unless (or noninteractive 759 emacs-basic-display 760 (and (memq window-system '(x w32 mac)) 761 (not (member (x-get-resource "cursorBlink" "CursorBlink") 762 '("off" "false"))))) 763 (setq no-blinking-cursor t)) 764 765 ;; If frame was created with a menu bar, set menu-bar-mode on. 766 (unless (or noninteractive 767 emacs-basic-display 768 (and (memq window-system '(x w32)) 769 (<= (frame-parameter nil 'menu-bar-lines) 0))) 770 (menu-bar-mode 1)) 771 772 ;; If frame was created with a tool bar, switch tool-bar-mode on. 773 (unless (or noninteractive 774 emacs-basic-display 775 (not (display-graphic-p)) 776 (<= (frame-parameter nil 'tool-bar-lines) 0)) 777 (tool-bar-mode 1)) 778 779 ;; Can't do this init in defcustom because the relevant variables 780 ;; are not set. 781 (custom-reevaluate-setting 'blink-cursor-mode) 782 (custom-reevaluate-setting 'normal-erase-is-backspace) 783 (custom-reevaluate-setting 'tooltip-mode) 784 (custom-reevaluate-setting 'global-font-lock-mode) 785 (custom-reevaluate-setting 'mouse-wheel-down-event) 786 (custom-reevaluate-setting 'mouse-wheel-up-event) 787 (custom-reevaluate-setting 'file-name-shadow-mode) 788 (custom-reevaluate-setting 'send-mail-function) 789 (custom-reevaluate-setting 'focus-follows-mouse) 790 791 ;; Register default TTY colors for the case the terminal hasn't a 792 ;; terminal init file. 793 (unless (memq window-system '(x w32 mac)) 794 ;; We do this regardles of whether the terminal supports colors 795 ;; or not, since they can switch that support on or off in 796 ;; mid-session by setting the tty-color-mode frame parameter. 797 (tty-register-default-colors)) 798 799 ;; Record whether the tool-bar is present before the user and site 800 ;; init files are processed. frame-notice-user-settings uses this 801 ;; to determine if the tool-bar has been disabled by the init files, 802 ;; and the frame needs to be resized. 803 (when (fboundp 'frame-notice-user-settings) 804 (let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist) 805 (assq 'tool-bar-lines default-frame-alist)))) 806 (setq tool-bar-originally-present 807 (and tool-bar-lines 808 (cdr tool-bar-lines) 809 (not (eq 0 (cdr tool-bar-lines))))))) 810 811 (let ((old-scalable-fonts-allowed scalable-fonts-allowed) 812 (old-font-list-limit font-list-limit) 813 (old-face-ignored-fonts face-ignored-fonts)) 814 815 ;; Run the site-start library if it exists. The point of this file is 816 ;; that it is run before .emacs. There is no point in doing this after 817 ;; .emacs; that is useless. 818 (if site-run-file 819 (load site-run-file t t)) 820 821 ;; Sites should not disable this. Only individuals should disable 822 ;; the startup message. 823 (setq inhibit-startup-message nil) 824 825 ;; Warn for invalid user name. 826 (when init-file-user 827 (if (string-match "[~/:\n]" init-file-user) 828 (display-warning 'initialization 829 (format "Invalid user name %s" 830 init-file-user) 831 :error) 832 (if (file-directory-p (expand-file-name 833 ;; We don't support ~USER on MS-Windows except 834 ;; for the current user, and always load .emacs 835 ;; from the current user's home directory (see 836 ;; below). So always check "~", even if invoked 837 ;; with "-u USER", or if $USER or $LOGNAME are 838 ;; set to something different. 839 (if (eq system-type 'windows-nt) 840 "~" 841 (concat "~" init-file-user)))) 842 nil 843 (display-warning 'initialization 844 (format "User %s has no home directory" 845 init-file-user) 846 :error)))) 847 848 ;; Load that user's init file, or the default one, or none. 849 (let (debug-on-error-from-init-file 850 debug-on-error-should-be-set 851 (debug-on-error-initial 852 (if (eq init-file-debug t) 'startup init-file-debug)) 853 (orig-enable-multibyte default-enable-multibyte-characters)) 854 (let ((debug-on-error debug-on-error-initial) 855 ;; This function actually reads the init files. 856 (inner 857 (function 858 (lambda () 859 (if init-file-user 860 (let ((user-init-file-1 861 (cond 862 ((eq system-type 'ms-dos) 863 (concat "~" init-file-user "/_emacs")) 864 ((eq system-type 'windows-nt) 865 ;; Prefer .emacs on Windows. 866 (if (directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$") 867 "~/.emacs" 868 ;; Also support _emacs for compatibility. 869 (if (directory-files "~" nil "^_emacs\\(\\.elc?\\)?$") 870 "~/_emacs" 871 ;; But default to .emacs if _emacs does not exist. 872 "~/.emacs"))) 873 ((eq system-type 'vax-vms) 874 "sys$login:.emacs") 875 (t 876 (concat "~" init-file-user "/.emacs"))))) 877 ;; This tells `load' to store the file name found 878 ;; into user-init-file. 879 (setq user-init-file t) 880 (load user-init-file-1 t t) 881 882 (when (eq user-init-file t) 883 ;; If we did not find ~/.emacs, try 884 ;; ~/.emacs.d/init.el. 885 (let ((otherfile 886 (expand-file-name 887 "init" 888 (file-name-as-directory 889 (concat "~" init-file-user "/.emacs.d"))))) 890 (load otherfile t t) 891 892 ;; If we did not find the user's init file, 893 ;; set user-init-file conclusively. 894 ;; Don't let it be set from default.el. 895 (when (eq user-init-file t) 896 (setq user-init-file user-init-file-1)))) 897 898 ;; If we loaded a compiled file, set 899 ;; `user-init-file' to the source version if that 900 ;; exists. 901 (when (and user-init-file 902 (equal (file-name-extension user-init-file) 903 "elc")) 904 (let* ((source (file-name-sans-extension user-init-file)) 905 (alt (concat source ".el"))) 906 (setq source (cond ((file-exists-p alt) alt) 907 ((file-exists-p source) source) 908 (t nil))) 909 (when source 910 (when (file-newer-than-file-p source user-init-file) 911 (message "Warning: %s is newer than %s" 912 source user-init-file) 913 (sit-for 1)) 914 (setq user-init-file source)))) 915 916 (unless inhibit-default-init 917 (let ((inhibit-startup-message nil)) 918 ;; Users are supposed to be told their rights. 919 ;; (Plus how to get help and how to undo.) 920 ;; Don't you dare turn this off for anyone 921 ;; except yourself. 922 (load "default" t t))))))))) 923 (if init-file-debug 924 ;; Do this without a condition-case if the user wants to debug. 925 (funcall inner) 926 (condition-case error 927 (progn 928 (funcall inner) 929 (setq init-file-had-error nil)) 930 (error 931 (let ((message-log-max nil)) 932 (save-excursion 933 (set-buffer (get-buffer-create "*Messages*")) 934 (insert "\n\n" 935 (format "An error has occurred while loading `%s':\n\n" 936 user-init-file) 937 (format "%s%s%s" 938 (get (car error) 'error-message) 939 (if (cdr error) ": " "") 940 (mapconcat (lambda (s) (prin1-to-string s t)) (cdr error) ", ")) 941 "\n\n" 942 "To ensure normal operation, you should investigate and remove the\n" 943 "cause of the error in your initialization file. Start Emacs with\n" 944 "the `--debug-init' option to view a complete error backtrace.\n\n")) 945 (message "Error in init file: %s%s%s" 946 (get (car error) 'error-message) 947 (if (cdr error) ": " "") 948 (mapconcat 'prin1-to-string (cdr error) ", ")) 949 (let ((pop-up-windows nil)) 950 (pop-to-buffer "*Messages*")) 951 (setq init-file-had-error t))))) 952 953 (if (and deactivate-mark transient-mark-mode) 954 (with-current-buffer (window-buffer) 955 (deactivate-mark))) 956 957 ;; If the user has a file of abbrevs, read it. 958 ;; FIXME: after the 22.0 release this should be changed so 959 ;; that it does not read the abbrev file when -batch is used 960 ;; on the command line. 961 (when (and (file-exists-p abbrev-file-name) 962 (file-readable-p abbrev-file-name)) 963 (quietly-read-abbrev-file abbrev-file-name)) 964 965 ;; If the abbrevs came entirely from the init file or the 966 ;; abbrevs file, they do not need saving. 967 (setq abbrevs-changed nil) 968 969 ;; If we can tell that the init file altered debug-on-error, 970 ;; arrange to preserve the value that it set up. 971 (or (eq debug-on-error debug-on-error-initial) 972 (setq debug-on-error-should-be-set t 973 debug-on-error-from-init-file debug-on-error))) 974 (if debug-on-error-should-be-set 975 (setq debug-on-error debug-on-error-from-init-file)) 976 (unless (or default-enable-multibyte-characters 977 (eq orig-enable-multibyte default-enable-multibyte-characters)) 978 ;; Init file changed to unibyte. Reset existing multibyte 979 ;; buffers (probably *scratch*, *Messages*, *Minibuff-0*). 980 ;; Arguably this should only be done if they're free of 981 ;; multibyte characters. 982 (mapcar (lambda (buffer) 983 (with-current-buffer buffer 984 (if enable-multibyte-characters 985 (set-buffer-multibyte nil)))) 986 (buffer-list)) 987 ;; Also re-set the language environment in case it was 988 ;; originally done before unibyte was set and is sensitive to 989 ;; unibyte (display table, terminal coding system &c). 990 (set-language-environment current-language-environment))) 991 992 ;; Do this here in case the init file sets mail-host-address. 993 (if (equal user-mail-address "") 994 (setq user-mail-address (or (getenv "EMAIL") 995 (concat (user-login-name) "@" 996 (or mail-host-address 997 (system-name)))))) 998 999 ;; Originally face attributes were specified via 1000 ;; `font-lock-face-attributes'. Users then changed the default 1001 ;; face attributes by setting that variable. However, we try and 1002 ;; be back-compatible and respect its value if set except for 1003 ;; faces where M-x customize has been used to save changes for the 1004 ;; face. 1005 (when (boundp 'font-lock-face-attributes) 1006 (let ((face-attributes font-lock-face-attributes)) 1007 (while face-attributes 1008 (let* ((face-attribute (pop face-attributes)) 1009 (face (car face-attribute))) 1010 ;; Rustle up a `defface' SPEC from a 1011 ;; `font-lock-face-attributes' entry. 1012 (unless (get face 'saved-face) 1013 (let ((foreground (nth 1 face-attribute)) 1014 (background (nth 2 face-attribute)) 1015 (bold-p (nth 3 face-attribute)) 1016 (italic-p (nth 4 face-attribute)) 1017 (underline-p (nth 5 face-attribute)) 1018 face-spec) 1019 (when foreground 1020 (setq face-spec (cons ':foreground (cons foreground face-spec)))) 1021 (when background 1022 (setq face-spec (cons ':background (cons background face-spec)))) 1023 (when bold-p 1024 (setq face-spec (append '(:weight bold) face-spec))) 1025 (when italic-p 1026 (setq face-spec (append '(:slant italic) face-spec))) 1027 (when underline-p 1028 (setq face-spec (append '(:underline t) face-spec))) 1029 (face-spec-set face (list (list t face-spec)) nil))))))) 1030 1031 ;; If parameter have been changed in the init file which influence 1032 ;; face realization, clear the face cache so that new faces will 1033 ;; be realized. 1034 (unless (and (eq scalable-fonts-allowed old-scalable-fonts-allowed) 1035 (eq font-list-limit old-font-list-limit) 1036 (eq face-ignored-fonts old-face-ignored-fonts)) 1037 (clear-face-cache))) 1038 1039 (run-hooks 'after-init-hook) 1040 1041 ;; Decode all default-directory. 1042 (if (and default-enable-multibyte-characters locale-coding-system) 1043 (save-excursion 1044 (dolist (elt (buffer-list)) 1045 (set-buffer elt) 1046 (if default-directory 1047 (setq default-directory 1048 (decode-coding-string default-directory 1049 locale-coding-system t)))) 1050 (setq command-line-default-directory 1051 (decode-coding-string command-line-default-directory 1052 locale-coding-system t)))) 1053 1054 ;; If *scratch* exists and init file didn't change its mode, initialize it. 1055 (if (get-buffer "*scratch*") 1056 (with-current-buffer "*scratch*" 1057 (if (eq major-mode 'fundamental-mode) 1058 (funcall initial-major-mode)))) 1059 1060 ;; Load library for our terminal type. 1061 ;; User init file can set term-file-prefix to nil to prevent this. 1062 (unless (or noninteractive 1063 window-system 1064 (null term-file-prefix)) 1065 (let* ((TERM (getenv "TERM")) 1066 (term TERM) 1067 hyphend) 1068 (while (and term 1069 (not (load (concat term-file-prefix term) t t))) 1070 ;; Strip off last hyphen and what follows, then try again 1071 (setq term 1072 (if (setq hyphend (string-match "[-_][^-_]+\\'" term)) 1073 (substring term 0 hyphend) 1074 nil))) 1075 (setq term TERM) 1076 ;; The terminal file has been loaded, now call the terminal specific 1077 ;; initialization function. 1078 (while term 1079 (let ((term-init-func (intern-soft (concat "terminal-init-" term)))) 1080 (if (not (fboundp term-init-func)) 1081 ;; Strip off last hyphen and what follows, then try again 1082 (setq term 1083 (if (setq hyphend (string-match "[-_][^-_]+\\'" term)) 1084 (substring term 0 hyphend) 1085 nil)) 1086 (setq term nil) 1087 (funcall term-init-func)))))) 1088 1089 ;; Update the out-of-memory error message based on user's key bindings 1090 ;; for save-some-buffers. 1091 (setq memory-signal-data 1092 (list 'error 1093 (substitute-command-keys "Memory exhausted--use \\[save-some-buffers] then exit and restart Emacs"))) 1094 1095 ;; Process the remaining args. 1096 (command-line-1 (cdr command-line-args)) 1097 1098 ;; If -batch, terminate after processing the command options. 1099 (if noninteractive (kill-emacs t)) 1100 1101 ;; Run emacs-session-restore (session management) if started by 1102 ;; the session manager and we have a session manager connection. 1103 (if (and (boundp 'x-session-previous-id) 1104 (stringp x-session-previous-id)) 1105 (with-no-warnings 1106 (emacs-session-restore x-session-previous-id)))) 1107 1108(defcustom initial-scratch-message (purecopy "\ 1109;; This buffer is for notes you don't want to save, and for Lisp evaluation. 1110;; If you want to create a file, visit that file with C-x C-f, 1111;; then enter the text in that file's own buffer. 1112 1113") 1114 "Initial message displayed in *scratch* buffer at startup. 1115If this is nil, no message will be displayed. 1116If `inhibit-splash-screen' is non-nil, then no message is displayed, 1117regardless of the value of this variable." 1118 :type '(choice (text :tag "Message") 1119 (const :tag "none" nil)) 1120 :group 'initialization) 1121 1122 1123;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1124;;; Fancy splash screen 1125;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1126 1127(defvar fancy-splash-text 1128 '((:face (variable-pitch :weight bold) 1129 "Important Help menu items:\n" 1130 :face variable-pitch 1131 (lambda () 1132 (let* ((en "TUTORIAL") 1133 (tut (or (get-language-info current-language-environment 1134 'tutorial) 1135 en)) 1136 (title (with-temp-buffer 1137 (insert-file-contents 1138 (expand-file-name tut data-directory) 1139 nil 0 256) 1140 (search-forward ".") 1141 (buffer-substring (point-min) (1- (point)))))) 1142 ;; If there is a specific tutorial for the current language 1143 ;; environment and it is not English, append its title. 1144 (concat 1145 "Emacs Tutorial\t\tLearn how to use Emacs efficiently" 1146 (if (string= en tut) 1147 "" 1148 (concat " (" title ")")) 1149 "\n"))) 1150 :face variable-pitch "\ 1151Emacs FAQ\t\tFrequently asked questions and answers 1152View Emacs Manual\t\tView the Emacs manual using Info 1153Absence of Warranty\tGNU Emacs comes with " 1154 :face (variable-pitch :slant oblique) 1155 "ABSOLUTELY NO WARRANTY\n" 1156 :face variable-pitch 1157 "\ 1158Copying Conditions\t\tConditions for redistributing and changing Emacs 1159Getting New Versions\tHow to obtain the latest version of Emacs 1160More Manuals / Ordering Manuals Buying printed manuals from the FSF\n") 1161 (:face variable-pitch 1162 "\nTo quit a partially entered command, type " 1163 :face default 1164 "Control-g" 1165 :face variable-pitch 1166 ". 1167 1168Emacs Guided Tour\t\tSee http://www.gnu.org/software/emacs/tour/ 1169 1170" 1171 :face (variable-pitch :weight bold) 1172 "Useful File menu items:\n" 1173 :face variable-pitch 1174 "Exit Emacs\t\t(Or type " 1175 :face default 1176 "Control-x" 1177 :face variable-pitch 1178 " followed by " 1179 :face default 1180 "Control-c" 1181 :face variable-pitch 1182 ") 1183Recover Crashed Session\tRecover files you were editing before a crash\n" 1184 )) 1185 "A list of texts to show in the middle part of splash screens. 1186Each element in the list should be a list of strings or pairs 1187`:face FACE', like `fancy-splash-insert' accepts them.") 1188 1189 1190(defgroup fancy-splash-screen () 1191 "Fancy splash screen when Emacs starts." 1192 :version "21.1" 1193 :group 'initialization) 1194 1195 1196(defcustom fancy-splash-delay 7 1197 "*Delay in seconds between splash screens." 1198 :group 'fancy-splash-screen 1199 :type 'integer) 1200 1201 1202(defcustom fancy-splash-max-time 30 1203 "*Show splash screens for at most this number of seconds. 1204Values less than twice `fancy-splash-delay' are ignored." 1205 :group 'fancy-splash-screen 1206 :type 'integer) 1207 1208 1209(defcustom fancy-splash-image nil 1210 "*The image to show in the splash screens, or nil for defaults." 1211 :group 'fancy-splash-screen 1212 :type '(choice (const :tag "Default" nil) 1213 (file :tag "File"))) 1214 1215 1216;; These are temporary storage areas for the splash screen display. 1217 1218(defvar fancy-current-text nil) 1219(defvar fancy-splash-help-echo nil) 1220(defvar fancy-splash-stop-time nil) 1221(defvar fancy-splash-outer-buffer nil) 1222(defvar fancy-splash-last-input-event nil) 1223 1224(defun fancy-splash-insert (&rest args) 1225 "Insert text into the current buffer, with faces. 1226Arguments from ARGS should be either strings, functions called 1227with no args that return a string, or pairs `:face FACE', 1228where FACE is a valid face specification, as it can be used with 1229`put-text-property'." 1230 (let ((current-face nil)) 1231 (while args 1232 (if (eq (car args) :face) 1233 (setq args (cdr args) current-face (car args)) 1234 (insert (propertize (let ((it (car args))) 1235 (if (functionp it) 1236 (funcall it) 1237 it)) 1238 'face current-face 1239 'help-echo fancy-splash-help-echo))) 1240 (setq args (cdr args))))) 1241 1242 1243(defun fancy-splash-head () 1244 "Insert the head part of the splash screen into the current buffer." 1245 (let* ((image-file (cond ((stringp fancy-splash-image) 1246 fancy-splash-image) 1247 ((and (display-color-p) 1248 (image-type-available-p 'xpm)) 1249 (if (and (fboundp 'x-display-planes) 1250 (= (funcall 'x-display-planes) 8)) 1251 "splash8.xpm" 1252 "splash.xpm")) 1253 (t "splash.pbm"))) 1254 (img (create-image image-file)) 1255 (image-width (and img (car (image-size img)))) 1256 (window-width (window-width (selected-window)))) 1257 (when img 1258 (when (> window-width image-width) 1259 ;; Center the image in the window. 1260 (insert (propertize " " 'display 1261 `(space :align-to (+ center (-0.5 . ,img))))) 1262 1263 ;; Change the color of the XPM version of the splash image 1264 ;; so that it is visible with a dark frame background. 1265 (when (and (memq 'xpm img) 1266 (eq (frame-parameter nil 'background-mode) 'dark)) 1267 (setq img (append img '(:color-symbols (("#000000" . "gray30")))))) 1268 1269 ;; Insert the image with a help-echo and a keymap. 1270 (let ((map (make-sparse-keymap)) 1271 (help-echo "mouse-2: browse http://www.gnu.org/")) 1272 (define-key map [mouse-2] 1273 (lambda () 1274 (interactive) 1275 (browse-url "http://www.gnu.org/") 1276 (throw 'exit nil))) 1277 (define-key map [down-mouse-2] 'ignore) 1278 (define-key map [up-mouse-2] 'ignore) 1279 (insert-image img (propertize "xxx" 'help-echo help-echo 1280 'keymap map))) 1281 (insert "\n")))) 1282 (fancy-splash-insert 1283 :face '(variable-pitch :foreground "red") 1284 (if (eq system-type 'gnu/linux) 1285 "GNU Emacs is one component of the GNU/Linux operating system." 1286 "GNU Emacs is one component of the GNU operating system.")) 1287 (insert "\n") 1288 (fancy-splash-insert 1289 :face 'variable-pitch 1290 "You can do basic editing with the menu bar and scroll bar \ 1291using the mouse.\n\n") 1292 (when fancy-splash-outer-buffer 1293 (fancy-splash-insert 1294 :face 'variable-pitch 1295 "Type " 1296 :face 'default 1297 "Control-l" 1298 :face 'variable-pitch 1299 " to begin editing" 1300 (if (equal (buffer-name fancy-splash-outer-buffer) 1301 "*scratch*") 1302 ".\n" 1303 " your file.\n")))) 1304 1305(defun fancy-splash-tail () 1306 "Insert the tail part of the splash screen into the current buffer." 1307 (let ((fg (if (eq (frame-parameter nil 'background-mode) 'dark) 1308 "cyan" "darkblue"))) 1309 (fancy-splash-insert :face `(variable-pitch :foreground ,fg) 1310 "\nThis is " 1311 (emacs-version) 1312 "\n" 1313 :face '(variable-pitch :height 0.5) 1314 "Copyright (C) 2007 Free Software Foundation, Inc.") 1315 (and auto-save-list-file-prefix 1316 ;; Don't signal an error if the 1317 ;; directory for auto-save-list files 1318 ;; does not yet exist. 1319 (file-directory-p (file-name-directory 1320 auto-save-list-file-prefix)) 1321 (directory-files 1322 (file-name-directory auto-save-list-file-prefix) 1323 nil 1324 (concat "\\`" 1325 (regexp-quote (file-name-nondirectory 1326 auto-save-list-file-prefix))) 1327 t) 1328 (fancy-splash-insert :face '(variable-pitch :foreground "red") 1329 "\n\nIf an Emacs session crashed recently, " 1330 "type " 1331 :face '(fixed-pitch :foreground "red") 1332 "Meta-x recover-session RET" 1333 :face '(variable-pitch :foreground "red") 1334 "\nto recover" 1335 " the files you were editing.")))) 1336 1337(defun fancy-splash-screens-1 (buffer) 1338 "Timer function displaying a splash screen." 1339 (when (> (float-time) fancy-splash-stop-time) 1340 (throw 'stop-splashing nil)) 1341 (unless fancy-current-text 1342 (setq fancy-current-text fancy-splash-text)) 1343 (let ((text (car fancy-current-text))) 1344 (set-buffer buffer) 1345 (erase-buffer) 1346 (if pure-space-overflow 1347 (insert "\ 1348Warning Warning!!! Pure space overflow !!!Warning Warning 1349\(See the node Pure Storage in the Lisp manual for details.)\n")) 1350 (fancy-splash-head) 1351 (apply #'fancy-splash-insert text) 1352 (fancy-splash-tail) 1353 (unless (current-message) 1354 (message fancy-splash-help-echo)) 1355 (set-buffer-modified-p nil) 1356 (goto-char (point-min)) 1357 (force-mode-line-update) 1358 (setq fancy-current-text (cdr fancy-current-text)))) 1359 1360 1361(defun fancy-splash-default-action () 1362 "Stop displaying the splash screen buffer. 1363This is an internal function used to turn off the splash screen after 1364the user caused an input event by hitting a key or clicking with the 1365mouse." 1366 (interactive) 1367 (if (and (memq 'down (event-modifiers last-command-event)) 1368 (eq (posn-window (event-start last-command-event)) 1369 (selected-window))) 1370 ;; This is a mouse-down event in the spash screen window. 1371 ;; Ignore it and consume the corresponding mouse-up event. 1372 (read-event) 1373 (push last-command-event unread-command-events)) 1374 (throw 'exit nil)) 1375 1376(defun fancy-splash-special-event-action () 1377 "Save the last event and stop displaying the splash screen buffer. 1378This is an internal function used to turn off the splash screen after 1379the user caused an input event that is bound in `special-event-map'" 1380 (interactive) 1381 (setq fancy-splash-last-input-event last-input-event) 1382 (throw 'exit nil)) 1383 1384 1385(defun fancy-splash-screens (&optional hide-on-input) 1386 "Display fancy splash screens when Emacs starts." 1387 (if hide-on-input 1388 (let ((old-hourglass display-hourglass) 1389 (fancy-splash-outer-buffer (current-buffer)) 1390 splash-buffer 1391 (old-minor-mode-map-alist minor-mode-map-alist) 1392 (old-emulation-mode-map-alists emulation-mode-map-alists) 1393 (old-special-event-map special-event-map) 1394 (frame (fancy-splash-frame)) 1395 timer) 1396 (save-selected-window 1397 (select-frame frame) 1398 (switch-to-buffer " GNU Emacs") 1399 (make-local-variable 'cursor-type) 1400 (setq splash-buffer (current-buffer)) 1401 (catch 'stop-splashing 1402 (unwind-protect 1403 (let ((map (make-sparse-keymap)) 1404 (cursor-type nil)) 1405 (use-local-map map) 1406 (define-key map [switch-frame] 'ignore) 1407 (define-key map [t] 'fancy-splash-default-action) 1408 (define-key map [mouse-movement] 'ignore) 1409 (define-key map [mode-line t] 'ignore) 1410 ;; Temporarily bind special events to 1411 ;; fancy-splash-special-event-action so as to stop 1412 ;; displaying splash screens with such events. 1413 ;; Otherwise, drag-n-drop into splash screens may 1414 ;; leave us in recursive editing with invisible 1415 ;; cursors for a while. 1416 (setq special-event-map (make-sparse-keymap)) 1417 (map-keymap 1418 (lambda (key def) 1419 (define-key special-event-map (vector key) 1420 (if (eq def 'ignore) 1421 'ignore 1422 'fancy-splash-special-event-action))) 1423 old-special-event-map) 1424 (setq display-hourglass nil 1425 minor-mode-map-alist nil 1426 emulation-mode-map-alists nil 1427 buffer-undo-list t 1428 mode-line-format (propertize "---- %b %-" 1429 'face 'mode-line-buffer-id) 1430 fancy-splash-stop-time (+ (float-time) 1431 fancy-splash-max-time) 1432 timer (run-with-timer 0 fancy-splash-delay 1433 #'fancy-splash-screens-1 1434 splash-buffer)) 1435 (message "%s" (startup-echo-area-message)) 1436 (recursive-edit)) 1437 (cancel-timer timer) 1438 (setq display-hourglass old-hourglass 1439 minor-mode-map-alist old-minor-mode-map-alist 1440 emulation-mode-map-alists old-emulation-mode-map-alists 1441 special-event-map old-special-event-map) 1442 (kill-buffer splash-buffer) 1443 (when fancy-splash-last-input-event 1444 (setq last-input-event fancy-splash-last-input-event 1445 fancy-splash-last-input-event nil) 1446 (command-execute (lookup-key special-event-map 1447 (vector last-input-event)) 1448 nil (vector last-input-event) t)))))) 1449 ;; If hide-on-input is nil, don't hide the buffer on input. 1450 (if (or (window-minibuffer-p) 1451 (window-dedicated-p (selected-window))) 1452 (pop-to-buffer (current-buffer)) 1453 (switch-to-buffer "*About GNU Emacs*")) 1454 (setq buffer-read-only nil) 1455 (erase-buffer) 1456 (if pure-space-overflow 1457 (insert "\ 1458Warning Warning!!! Pure space overflow !!!Warning Warning 1459\(See the node Pure Storage in the Lisp manual for details.)\n")) 1460 (let (fancy-splash-outer-buffer) 1461 (fancy-splash-head) 1462 (dolist (text fancy-splash-text) 1463 (apply #'fancy-splash-insert text) 1464 (insert "\n")) 1465 (skip-chars-backward "\n") 1466 (delete-region (point) (point-max)) 1467 (insert "\n") 1468 (fancy-splash-tail) 1469 (set-buffer-modified-p nil) 1470 (setq buffer-read-only t) 1471 (if (and view-read-only (not view-mode)) 1472 (view-mode-enter nil 'kill-buffer)) 1473 (goto-char (point-min))))) 1474 1475(defun fancy-splash-frame () 1476 "Return the frame to use for the fancy splash screen. 1477Returning non-nil does not mean we should necessarily 1478use the fancy splash screen, but if we do use it, 1479we put it on this frame." 1480 (let (chosen-frame) 1481 (dolist (frame (append (frame-list) (list (selected-frame)))) 1482 (if (and (frame-visible-p frame) 1483 (not (window-minibuffer-p (frame-selected-window frame)))) 1484 (setq chosen-frame frame))) 1485 chosen-frame)) 1486 1487(defun use-fancy-splash-screens-p () 1488 "Return t if fancy splash screens should be used." 1489 (when (and (display-graphic-p) 1490 (or (and (display-color-p) 1491 (image-type-available-p 'xpm)) 1492 (image-type-available-p 'pbm))) 1493 (let ((frame (fancy-splash-frame))) 1494 (when frame 1495 (let* ((img (create-image (or fancy-splash-image 1496 (if (and (display-color-p) 1497 (image-type-available-p 'xpm)) 1498 "splash.xpm" "splash.pbm")))) 1499 (image-height (and img (cdr (image-size img nil frame)))) 1500 ;; We test frame-height so that, if the frame is split 1501 ;; by displaying a warning, that doesn't cause the normal 1502 ;; splash screen to be used. 1503 (frame-height (1- (frame-height frame)))) 1504 (> frame-height (+ image-height 19))))))) 1505 1506 1507(defun normal-splash-screen (&optional hide-on-input) 1508 "Display splash screen when Emacs starts." 1509 (let ((prev-buffer (current-buffer))) 1510 (unwind-protect 1511 (with-current-buffer (get-buffer-create "GNU Emacs") 1512 (setq buffer-read-only nil) 1513 (erase-buffer) 1514 (set (make-local-variable 'tab-width) 8) 1515 (if hide-on-input 1516 (set (make-local-variable 'mode-line-format) 1517 (propertize "---- %b %-" 'face 'mode-line-buffer-id))) 1518 1519 (if pure-space-overflow 1520 (insert "\ 1521Warning Warning!!! Pure space overflow !!!Warning Warning 1522\(See the node Pure Storage in the Lisp manual for details.)\n")) 1523 1524 ;; The convention for this piece of code is that 1525 ;; each piece of output starts with one or two newlines 1526 ;; and does not end with any newlines. 1527 (insert "Welcome to GNU Emacs") 1528 (insert 1529 (if (eq system-type 'gnu/linux) 1530 ", one component of the GNU/Linux operating system.\n" 1531 ", a part of the GNU operating system.\n")) 1532 1533 (if hide-on-input 1534 (insert (substitute-command-keys 1535 (concat 1536 "\nType \\[recenter] to begin editing" 1537 (if (equal (buffer-name prev-buffer) "*scratch*") 1538 ".\n" 1539 " your file.\n"))))) 1540 1541 (if (display-mouse-p) 1542 ;; The user can use the mouse to activate menus 1543 ;; so give help in terms of menu items. 1544 (progn 1545 (insert "\ 1546You can do basic editing with the menu bar and scroll bar using the mouse. 1547To quit a partially entered command, type Control-g. 1548 1549Useful File menu items: 1550Exit Emacs (or type Control-x followed by Control-c) 1551Recover Crashed Session Recover files you were editing before a crash 1552 1553Important Help menu items: 1554Emacs Tutorial Learn how to use Emacs efficiently 1555Emacs FAQ Frequently asked questions and answers 1556Read the Emacs Manual View the Emacs manual using Info 1557\(Non)Warranty GNU Emacs comes with ABSOLUTELY NO WARRANTY 1558Copying Conditions Conditions for redistributing and changing Emacs 1559Getting New Versions How to obtain the latest version of Emacs 1560More Manuals / Ordering Manuals How to order printed manuals from the FSF 1561") 1562 (insert "\n\n" (emacs-version) 1563 " 1564Copyright (C) 2007 Free Software Foundation, Inc.")) 1565 1566 ;; No mouse menus, so give help using kbd commands. 1567 1568 ;; If keys have their default meanings, 1569 ;; use precomputed string to save lots of time. 1570 (if (and (eq (key-binding "\C-h") 'help-command) 1571 (eq (key-binding "\C-xu") 'advertised-undo) 1572 (eq (key-binding "\C-x\C-c") 'save-buffers-kill-emacs) 1573 (eq (key-binding "\C-ht") 'help-with-tutorial) 1574 (eq (key-binding "\C-hi") 'info) 1575 (eq (key-binding "\C-hr") 'info-emacs-manual) 1576 (eq (key-binding "\C-h\C-n") 'view-emacs-news)) 1577 (insert " 1578Get help C-h (Hold down CTRL and press h) 1579Emacs manual C-h r 1580Emacs tutorial C-h t Undo changes C-x u 1581Buy manuals C-h C-m Exit Emacs C-x C-c 1582Browse manuals C-h i") 1583 1584 (insert (substitute-command-keys 1585 (format "\n 1586Get help %s 1587Emacs manual \\[info-emacs-manual] 1588Emacs tutorial \\[help-with-tutorial]\tUndo changes\t\\[advertised-undo] 1589Buy manuals \\[view-order-manuals]\tExit Emacs\t\\[save-buffers-kill-emacs] 1590Browse manuals \\[info]" 1591 (let ((where (where-is-internal 1592 'help-command nil t))) 1593 (if where 1594 (key-description where) 1595 "M-x help")))))) 1596 1597 ;; Say how to use the menu bar with the keyboard. 1598 (if (and (eq (key-binding "\M-`") 'tmm-menubar) 1599 (eq (key-binding [f10]) 'tmm-menubar)) 1600 (insert " 1601Activate menubar F10 or ESC ` or M-`") 1602 (insert (substitute-command-keys " 1603Activate menubar \\[tmm-menubar]"))) 1604 1605 ;; Many users seem to have problems with these. 1606 (insert " 1607\(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key. 1608If you have no Meta key, you may instead type ESC followed by the character.)") 1609 1610 (insert "\n\n" (emacs-version) 1611 " 1612Copyright (C) 2007 Free Software Foundation, Inc.") 1613 1614 (if (and (eq (key-binding "\C-h\C-c") 'describe-copying) 1615 (eq (key-binding "\C-h\C-d") 'describe-distribution) 1616 (eq (key-binding "\C-h\C-w") 'describe-no-warranty)) 1617 (insert 1618 "\n 1619GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details. 1620Emacs is Free Software--Free as in Freedom--so you can redistribute copies 1621of Emacs and modify it; type C-h C-c to see the conditions. 1622Type C-h C-d for information on getting the latest version.") 1623 (insert (substitute-command-keys 1624 "\n 1625GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details. 1626Emacs is Free Software--Free as in Freedom--so you can redistribute copies 1627of Emacs and modify it; type \\[describe-copying] to see the conditions. 1628Type \\[describe-distribution] for information on getting the latest version.")))) 1629 1630 ;; The rest of the startup screen is the same on all 1631 ;; kinds of terminals. 1632 1633 ;; Give information on recovering, if there was a crash. 1634 (and auto-save-list-file-prefix 1635 ;; Don't signal an error if the 1636 ;; directory for auto-save-list files 1637 ;; does not yet exist. 1638 (file-directory-p (file-name-directory 1639 auto-save-list-file-prefix)) 1640 (directory-files 1641 (file-name-directory auto-save-list-file-prefix) 1642 nil 1643 (concat "\\`" 1644 (regexp-quote (file-name-nondirectory 1645 auto-save-list-file-prefix))) 1646 t) 1647 (insert "\n\nIf an Emacs session crashed recently, " 1648 "type Meta-x recover-session RET\nto recover" 1649 " the files you were editing.")) 1650 1651 ;; Display the input that we set up in the buffer. 1652 (set-buffer-modified-p nil) 1653 (setq buffer-read-only t) 1654 (if (and view-read-only (not view-mode)) 1655 (view-mode-enter nil 'kill-buffer)) 1656 (goto-char (point-min)) 1657 (if hide-on-input 1658 (if (or (window-minibuffer-p) 1659 (window-dedicated-p (selected-window))) 1660 ;; If hide-on-input is nil, creating a new frame will 1661 ;; generate enough events that the subsequent `sit-for' 1662 ;; will immediately return anyway. 1663 nil ;; (pop-to-buffer (current-buffer)) 1664 (save-window-excursion 1665 (switch-to-buffer (current-buffer)) 1666 (sit-for 120))) 1667 (condition-case nil 1668 (switch-to-buffer (current-buffer)) 1669 ;; In case the window is dedicated or something. 1670 (error (pop-to-buffer (current-buffer)))))) 1671 ;; Unwind ... ensure splash buffer is killed 1672 (if hide-on-input 1673 (kill-buffer "GNU Emacs") 1674 (switch-to-buffer "GNU Emacs") 1675 (rename-buffer "*About GNU Emacs*" t))))) 1676 1677 1678(defun startup-echo-area-message () 1679 (if (eq (key-binding "\C-h\C-p") 'describe-project) 1680 "For information about the GNU Project and its goals, type C-h C-p." 1681 (substitute-command-keys 1682 "For information about the GNU Project and its goals, type \ 1683\\[describe-project]."))) 1684 1685 1686(defun display-startup-echo-area-message () 1687 (let ((resize-mini-windows t)) 1688 (message "%s" (startup-echo-area-message)))) 1689 1690 1691(defun display-splash-screen (&optional hide-on-input) 1692 "Display splash screen according to display. 1693Fancy splash screens are used on graphic displays, 1694normal otherwise. 1695With a prefix argument, any user input hides the splash screen." 1696 (interactive "P") 1697 (if (use-fancy-splash-screens-p) 1698 (fancy-splash-screens hide-on-input) 1699 (normal-splash-screen hide-on-input))) 1700 1701 1702(defun command-line-1 (command-line-args-left) 1703 (or noninteractive (input-pending-p) init-file-had-error 1704 ;; t if the init file says to inhibit the echo area startup message. 1705 (and inhibit-startup-echo-area-message 1706 user-init-file 1707 (or (and (get 'inhibit-startup-echo-area-message 'saved-value) 1708 (equal inhibit-startup-echo-area-message 1709 (if (equal init-file-user "") 1710 (user-login-name) 1711 init-file-user))) 1712 ;; Wasn't set with custom; see if .emacs has a setq. 1713 (let ((buffer (get-buffer-create " *temp*"))) 1714 (prog1 1715 (condition-case nil 1716 (save-excursion 1717 (set-buffer buffer) 1718 (insert-file-contents user-init-file) 1719 (re-search-forward 1720 (concat 1721 "([ \t\n]*setq[ \t\n]+" 1722 "inhibit-startup-echo-area-message[ \t\n]+" 1723 (regexp-quote 1724 (prin1-to-string 1725 (if (equal init-file-user "") 1726 (user-login-name) 1727 init-file-user))) 1728 "[ \t\n]*)") 1729 nil t)) 1730 (error nil)) 1731 (kill-buffer buffer))))) 1732 ;; display-splash-screen at the end of command-line-1 calls 1733 ;; use-fancy-splash-screens-p. This can cause image.el to be 1734 ;; loaded, putting "Loading image... done" in the echo area. 1735 ;; This hides startup-echo-area-message. So 1736 ;; use-fancy-splash-screens-p is called here simply to get the 1737 ;; loading of image.el (if needed) out of the way before 1738 ;; display-startup-echo-area-message runs. 1739 (progn 1740 (use-fancy-splash-screens-p) 1741 (display-startup-echo-area-message))) 1742 1743 ;; Delay 2 seconds after an init file error message 1744 ;; was displayed, so user can read it. 1745 (when init-file-had-error 1746 (sit-for 2)) 1747 1748 (when (and pure-space-overflow 1749 (not noninteractive)) 1750 (display-warning 1751 'initialization 1752 "Building Emacs overflowed pure space. (See the node Pure Storage in the Lisp manual for details.)" 1753 :warning)) 1754 1755 (when command-line-args-left 1756 ;; We have command args; process them. 1757 (let ((dir command-line-default-directory) 1758 (file-count 0) 1759 first-file-buffer 1760 tem 1761 ;; This approach loses for "-batch -L DIR --eval "(require foo)", 1762 ;; if foo is intended to be found in DIR. 1763 ;; 1764 ;; ;; The directories listed in --directory/-L options will *appear* 1765 ;; ;; at the front of `load-path' in the order they appear on the 1766 ;; ;; command-line. We cannot do this by *placing* them at the front 1767 ;; ;; in the order they appear, so we need this variable to hold them, 1768 ;; ;; temporarily. 1769 ;; extra-load-path 1770 ;; 1771 ;; To DTRT we keep track of the splice point and modify `load-path' 1772 ;; straight away upon any --directory/-L option. 1773 splice 1774 just-files ;; t if this follows the magic -- option. 1775 ;; This includes our standard options' long versions 1776 ;; and long versions of what's on command-switch-alist. 1777 (longopts 1778 (append '(("--funcall") ("--load") ("--insert") ("--kill") 1779 ("--directory") ("--eval") ("--execute") ("--no-splash") 1780 ("--find-file") ("--visit") ("--file") ("--no-desktop")) 1781 (mapcar (lambda (elt) 1782 (list (concat "-" (car elt)))) 1783 command-switch-alist))) 1784 (line 0) 1785 (column 0)) 1786 1787 ;; Add the long X options to longopts. 1788 (dolist (tem command-line-x-option-alist) 1789 (if (string-match "^--" (car tem)) 1790 (push (list (car tem)) longopts))) 1791 1792 ;; Loop, processing options. 1793 (while command-line-args-left 1794 (let* ((argi (car command-line-args-left)) 1795 (orig-argi argi) 1796 argval completion) 1797 (setq command-line-args-left (cdr command-line-args-left)) 1798 1799 ;; Do preliminary decoding of the option. 1800 (if just-files 1801 ;; After --, don't look for options; treat all args as files. 1802 (setq argi "") 1803 ;; Convert long options to ordinary options 1804 ;; and separate out an attached option argument into argval. 1805 (when (string-match "^\\(--[^=]*\\)=" argi) 1806 (setq argval (substring argi (match-end 0)) 1807 argi (match-string 1 argi))) 1808 (if (equal argi "--") 1809 (setq completion nil) 1810 (setq completion (try-completion argi longopts))) 1811 (if (eq completion t) 1812 (setq argi (substring argi 1)) 1813 (if (stringp completion) 1814 (let ((elt (assoc completion longopts))) 1815 (or elt 1816 (error "Option `%s' is ambiguous" argi)) 1817 (setq argi (substring (car elt) 1))) 1818 (setq argval nil 1819 argi orig-argi)))) 1820 1821 ;; Execute the option. 1822 (cond ((setq tem (assoc argi command-switch-alist)) 1823 (if argval 1824 (let ((command-line-args-left 1825 (cons argval command-line-args-left))) 1826 (funcall (cdr tem) argi)) 1827 (funcall (cdr tem) argi))) 1828 1829 ((equal argi "-no-splash") 1830 (setq inhibit-startup-message t)) 1831 1832 ((member argi '("-f" ; what the manual claims 1833 "-funcall" 1834 "-e")) ; what the source used to say 1835 (setq tem (intern (or argval (pop command-line-args-left)))) 1836 (if (commandp tem) 1837 (command-execute tem) 1838 (funcall tem))) 1839 1840 ((member argi '("-eval" "-execute")) 1841 (eval (read (or argval (pop command-line-args-left))))) 1842 1843 ((member argi '("-L" "-directory")) 1844 (setq tem (expand-file-name 1845 (command-line-normalize-file-name 1846 (or argval (pop command-line-args-left))))) 1847 (cond (splice (setcdr splice (cons tem (cdr splice))) 1848 (setq splice (cdr splice))) 1849 (t (setq load-path (cons tem load-path) 1850 splice load-path)))) 1851 1852 ((member argi '("-l" "-load")) 1853 (let* ((file (command-line-normalize-file-name 1854 (or argval (pop command-line-args-left)))) 1855 ;; Take file from default dir if it exists there; 1856 ;; otherwise let `load' search for it. 1857 (file-ex (expand-file-name file))) 1858 (when (file-exists-p file-ex) 1859 (setq file file-ex)) 1860 (load file nil t))) 1861 1862 ;; This is used to handle -script. It's not clear 1863 ;; we need to document it. 1864 ((member argi '("-scriptload")) 1865 (let* ((file (command-line-normalize-file-name 1866 (or argval (pop command-line-args-left)))) 1867 ;; Take file from default dir. 1868 (file-ex (expand-file-name file))) 1869 (load file-ex nil t t))) 1870 1871 ((equal argi "-insert") 1872 (setq tem (or argval (pop command-line-args-left))) 1873 (or (stringp tem) 1874 (error "File name omitted from `-insert' option")) 1875 (insert-file-contents (command-line-normalize-file-name tem))) 1876 1877 ((equal argi "-kill") 1878 (kill-emacs t)) 1879 1880 ;; This is for when they use --no-desktop with -q, or 1881 ;; don't load Desktop in their .emacs. If desktop.el 1882 ;; _is_ loaded, it will handle this switch, and we 1883 ;; won't see it by the time we get here. 1884 ((equal argi "-no-desktop") 1885 (message "\"--no-desktop\" ignored because the Desktop package is not loaded")) 1886 1887 ((string-match "^\\+[0-9]+\\'" argi) 1888 (setq line (string-to-number argi))) 1889 1890 ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi) 1891 (setq line (string-to-number (match-string 1 argi)) 1892 column (string-to-number (match-string 2 argi)))) 1893 1894 ((setq tem (assoc argi command-line-x-option-alist)) 1895 ;; Ignore X-windows options and their args if not using X. 1896 (setq command-line-args-left 1897 (nthcdr (nth 1 tem) command-line-args-left))) 1898 1899 ((member argi '("-find-file" "-file" "-visit")) 1900 ;; An explicit option to specify visiting a file. 1901 (setq tem (or argval (pop command-line-args-left))) 1902 (unless (stringp tem) 1903 (error "File name omitted from `%s' option" argi)) 1904 (setq file-count (1+ file-count)) 1905 (let ((file (expand-file-name 1906 (command-line-normalize-file-name tem) dir))) 1907 (if (= file-count 1) 1908 (setq first-file-buffer (find-file file)) 1909 (find-file-other-window file))) 1910 (or (zerop line) 1911 (goto-line line)) 1912 (setq line 0) 1913 (unless (< column 1) 1914 (move-to-column (1- column))) 1915 (setq column 0)) 1916 1917 ((equal argi "--") 1918 (setq just-files t)) 1919 (t 1920 ;; We have almost exhausted our options. See if the 1921 ;; user has made any other command-line options available 1922 (let ((hooks command-line-functions) ;; lrs 7/31/89 1923 (did-hook nil)) 1924 (while (and hooks 1925 (not (setq did-hook (funcall (car hooks))))) 1926 (setq hooks (cdr hooks))) 1927 (if (not did-hook) 1928 ;; Presume that the argument is a file name. 1929 (progn 1930 (if (string-match "\\`-" argi) 1931 (error "Unknown option `%s'" argi)) 1932 (setq file-count (1+ file-count)) 1933 (let ((file 1934 (expand-file-name 1935 (command-line-normalize-file-name orig-argi) 1936 dir))) 1937 (if (= file-count 1) 1938 (setq first-file-buffer (find-file file)) 1939 (find-file-other-window file))) 1940 (or (zerop line) 1941 (goto-line line)) 1942 (setq line 0) 1943 (unless (< column 1) 1944 (move-to-column (1- column))) 1945 (setq column 0)))))) 1946 ;; In unusual circumstances, the execution of Lisp code due 1947 ;; to command-line options can cause the last visible frame 1948 ;; to be deleted. In this case, kill emacs to avoid an 1949 ;; abort later. 1950 (unless (frame-live-p (selected-frame)) (kill-emacs nil)))) 1951 1952 ;; If 3 or more files visited, and not all visible, 1953 ;; show user what they all are. But leave the last one current. 1954 (and (> file-count 2) 1955 (not noninteractive) 1956 (not inhibit-startup-buffer-menu) 1957 (or (get-buffer-window first-file-buffer) 1958 (list-buffers))))) 1959 1960 ;; Maybe display a startup screen. 1961 (unless (or inhibit-startup-message 1962 noninteractive 1963 emacs-quick-startup) 1964 ;; Display a startup screen, after some preparations. 1965 1966 ;; If there are no switches to process, we might as well 1967 ;; run this hook now, and there may be some need to do it 1968 ;; before doing any output. 1969 (run-hooks 'emacs-startup-hook) 1970 (and term-setup-hook 1971 (run-hooks 'term-setup-hook)) 1972 (setq inhibit-startup-hooks t) 1973 1974 ;; It's important to notice the user settings before we 1975 ;; display the startup message; otherwise, the settings 1976 ;; won't take effect until the user gives the first 1977 ;; keystroke, and that's distracting. 1978 (when (fboundp 'frame-notice-user-settings) 1979 (frame-notice-user-settings)) 1980 1981 ;; If there are no switches to process, we might as well 1982 ;; run this hook now, and there may be some need to do it 1983 ;; before doing any output. 1984 (when window-setup-hook 1985 (run-hooks 'window-setup-hook) 1986 ;; Don't let the hook be run twice. 1987 (setq window-setup-hook nil)) 1988 1989 ;; Do this now to avoid an annoying delay if the user 1990 ;; clicks the menu bar during the sit-for. 1991 (when (display-popup-menus-p) 1992 (precompute-menubar-bindings)) 1993 (with-no-warnings 1994 (setq menubar-bindings-done t)) 1995 1996 ;; If *scratch* exists and is empty, insert initial-scratch-message. 1997 (and initial-scratch-message 1998 (get-buffer "*scratch*") 1999 (with-current-buffer "*scratch*" 2000 (when (zerop (buffer-size)) 2001 (insert initial-scratch-message) 2002 (set-buffer-modified-p nil)))) 2003 2004 ;; If user typed input during all that work, 2005 ;; abort the startup screen. Otherwise, display it now. 2006 (unless (input-pending-p) 2007 (display-splash-screen t)))) 2008 2009 2010(defun command-line-normalize-file-name (file) 2011 "Collapse multiple slashes to one, to handle non-Emacs file names." 2012 (save-match-data 2013 ;; Use arg 1 so that we don't collapse // at the start of the file name. 2014 ;; That is significant on some systems. 2015 ;; However, /// at the beginning is supposed to mean just /, not //. 2016 (if (string-match "^///+" file) 2017 (setq file (replace-match "/" t t file))) 2018 (while (string-match "//+" file 1) 2019 (setq file (replace-match "/" t t file))) 2020 file)) 2021 2022;; arch-tag: 7e294698-244d-4758-984b-4047f887a5db 2023;;; startup.el ends here 2024