LCOV - code coverage report
Current view: top level - lisp - startup.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 19 1188 1.6 %
Date: 2017-08-30 10:12:24 Functions: 2 71 2.8 %

          Line data    Source code
       1             : ;;; startup.el --- process Emacs shell arguments  -*- lexical-binding: t -*-
       2             : 
       3             : ;; Copyright (C) 1985-1986, 1992, 1994-2017 Free Software Foundation,
       4             : ;; Inc.
       5             : 
       6             : ;; Maintainer: emacs-devel@gnu.org
       7             : ;; Keywords: internal
       8             : ;; Package: emacs
       9             : 
      10             : ;; This file is part of GNU Emacs.
      11             : 
      12             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      13             : ;; it under the terms of the GNU General Public License as published by
      14             : ;; the Free Software Foundation, either version 3 of the License, or
      15             : ;; (at your option) any later version.
      16             : 
      17             : ;; GNU Emacs is distributed in the hope that it will be useful,
      18             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      19             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      20             : ;; GNU General Public License for more details.
      21             : 
      22             : ;; You should have received a copy of the GNU General Public License
      23             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      24             : 
      25             : ;;; Commentary:
      26             : 
      27             : ;; This file parses the command line and gets Emacs running.  Options
      28             : ;; on the command line are handled in precedence order.  For priorities
      29             : ;; see the structure standard_args in the emacs.c file.
      30             : 
      31             : ;;; Code:
      32             : 
      33             : (setq top-level '(normal-top-level))
      34             : 
      35             : (defvar command-line-processed nil
      36             :   "Non-nil once command line has been processed.")
      37             : 
      38             : (defgroup initialization nil
      39             :   "Emacs start-up procedure."
      40             :   :group 'environment)
      41             : 
      42             : (defcustom initial-buffer-choice nil
      43             :   "Buffer to show after starting Emacs.
      44             : If the value is nil and `inhibit-startup-screen' is nil, show the
      45             : startup screen.  If the value is a string, switch to a buffer
      46             : visiting the file or directory that the string specifies.  If the
      47             : value is a function, call it with no arguments and switch to the buffer
      48             : that it returns.  If t, open the `*scratch*' buffer.
      49             : 
      50             : When `initial-buffer-choice' is non-nil, the startup screen is
      51             : inhibited.
      52             : 
      53             : If you use `emacsclient' with no target file, then it obeys any
      54             : string or function value that this variable has."
      55             :   :type '(choice
      56             :           (const     :tag "Startup screen" nil)
      57             :           (directory :tag "Directory" :value "~/")
      58             :           (file      :tag "File" :value "~/.emacs")
      59             :           ;; Note sure about hard-coding this as an option...
      60             :           (const     :tag "Remember Mode notes buffer" remember-notes)
      61             :           (function  :tag "Function")
      62             :           (const     :tag "Lisp scratch buffer" t))
      63             :   :version "23.1"
      64             :   :group 'initialization)
      65             : 
      66             : (defcustom inhibit-startup-screen nil
      67             :   "Non-nil inhibits the startup screen.
      68             : 
      69             : This is for use in your personal init file (but NOT site-start.el),
      70             : once you are familiar with the contents of the startup screen."
      71             :   :type 'boolean
      72             :   :group 'initialization)
      73             : 
      74             : (defvaralias 'inhibit-splash-screen 'inhibit-startup-screen)
      75             : (defvaralias 'inhibit-startup-message 'inhibit-startup-screen)
      76             : 
      77             : (defvar startup-screen-inhibit-startup-screen nil)
      78             : 
      79             : ;; The mechanism used to ensure that only end users can disable this
      80             : ;; message is not complex.  Clearly, it is possible for a determined
      81             : ;; system administrator to inhibit this message anyway, but at least
      82             : ;; they will do so with knowledge of why the Emacs developers think
      83             : ;; this is a bad idea.
      84             : (defcustom inhibit-startup-echo-area-message nil
      85             :   "Non-nil inhibits the initial startup echo area message.
      86             : 
      87             : The startup message is in the echo area as it provides information
      88             : about GNU Emacs and the GNU system in general, which we want all
      89             : users to see.  As this is the least intrusive startup message,
      90             : this variable gets specialized treatment to prevent the message
      91             : from being disabled site-wide by systems administrators, while
      92             : still allowing individual users to do so.
      93             : 
      94             : Setting this variable takes effect only if you do it with the
      95             : customization buffer or if your init file contains a line of this
      96             : form:
      97             :  (setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\")
      98             : If your init file is byte-compiled, use the following form
      99             : instead:
     100             :  (eval \\='(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\"))
     101             : Thus, someone else using a copy of your init file will see the
     102             : startup message unless he personally acts to inhibit it."
     103             :   :type '(choice (const :tag "Don't inhibit")
     104             :                  (string :tag "Enter your user name, to inhibit"))
     105             :   :group 'initialization)
     106             : 
     107             : (defcustom inhibit-default-init nil
     108             :   "Non-nil inhibits loading the `default' library."
     109             :   :type 'boolean
     110             :   :group 'initialization)
     111             : 
     112             : (defcustom inhibit-startup-buffer-menu nil
     113             :   "Non-nil inhibits display of buffer list when more than 2 files are loaded."
     114             :   :type 'boolean
     115             :   :group 'initialization)
     116             : 
     117             : (defvar command-switch-alist nil
     118             :   "Alist of command-line switches.
     119             : Elements look like (SWITCH-STRING . HANDLER-FUNCTION).
     120             : HANDLER-FUNCTION receives the switch string as its sole argument;
     121             : the remaining command-line args are in the variable `command-line-args-left'.")
     122             : 
     123             : (defvar command-line-args-left nil
     124             :   "List of command-line args not yet processed.")
     125             : 
     126             : (defvaralias 'argv 'command-line-args-left
     127             :   "List of command-line args not yet processed.
     128             : This is a convenience alias, so that one can write \(pop argv)
     129             : inside of --eval command line arguments in order to access
     130             : following arguments.")
     131             : (internal-make-var-non-special 'argv)
     132             : 
     133             : (defvar argi nil
     134             :   "Current command-line argument.")
     135             : (internal-make-var-non-special 'argi)
     136             : 
     137             : (defvar command-line-functions nil    ;; lrs 7/31/89
     138             :   "List of functions to process unrecognized command-line arguments.
     139             : Each function should access the dynamically bound variables
     140             : `argi' (the current argument) and `command-line-args-left' (the remaining
     141             : arguments).  The function should return non-nil only if it recognizes and
     142             : processes `argi'.  If it does so, it may consume successive arguments by
     143             : altering `command-line-args-left' to remove them.")
     144             : 
     145             : (defvar command-line-default-directory nil
     146             :   "Default directory to use for command line arguments.
     147             : This is normally copied from `default-directory' when Emacs starts.")
     148             : 
     149             : ;; This is here, rather than in x-win.el, so that we can ignore these
     150             : ;; options when we are not using X.
     151             : (defconst command-line-x-option-alist
     152             :   '(("-bw" 1 x-handle-numeric-switch border-width)
     153             :     ("-d" 1 x-handle-display)
     154             :     ("-display" 1 x-handle-display)
     155             :     ("-name" 1 x-handle-name-switch)
     156             :     ("-title" 1 x-handle-switch title)
     157             :     ("-T" 1 x-handle-switch title)
     158             :     ("-r" 0 x-handle-switch reverse t)
     159             :     ("-rv" 0 x-handle-switch reverse t)
     160             :     ("-reverse" 0 x-handle-switch reverse t)
     161             :     ("-reverse-video" 0 x-handle-switch reverse t)
     162             :     ("-fn" 1 x-handle-switch font)
     163             :     ("-font" 1 x-handle-switch font)
     164             :     ("-fs" 0 x-handle-initial-switch fullscreen fullboth)
     165             :     ("-fw" 0 x-handle-initial-switch fullscreen fullwidth)
     166             :     ("-fh" 0 x-handle-initial-switch fullscreen fullheight)
     167             :     ("-mm" 0 x-handle-initial-switch fullscreen maximized)
     168             :     ("-ib" 1 x-handle-numeric-switch internal-border-width)
     169             :     ("-g" 1 x-handle-geometry)
     170             :     ("-lsp" 1 x-handle-numeric-switch line-spacing)
     171             :     ("-geometry" 1 x-handle-geometry)
     172             :     ("-fg" 1 x-handle-switch foreground-color)
     173             :     ("-foreground" 1 x-handle-switch foreground-color)
     174             :     ("-bg" 1 x-handle-switch background-color)
     175             :     ("-background" 1 x-handle-switch background-color)
     176             :     ("-ms" 1 x-handle-switch mouse-color)
     177             :     ("-nbi" 0 x-handle-switch icon-type nil)
     178             :     ("-iconic" 0 x-handle-iconic)
     179             :     ("-xrm" 1 x-handle-xrm-switch)
     180             :     ("-cr" 1 x-handle-switch cursor-color)
     181             :     ("-vb" 0 x-handle-switch vertical-scroll-bars t)
     182             :     ("-hb" 0 x-handle-switch horizontal-scroll-bars t)
     183             :     ("-bd" 1 x-handle-switch)
     184             :     ("--border-width" 1 x-handle-numeric-switch border-width)
     185             :     ("--display" 1 x-handle-display)
     186             :     ("--name" 1 x-handle-name-switch)
     187             :     ("--title" 1 x-handle-switch title)
     188             :     ("--reverse-video" 0 x-handle-switch reverse t)
     189             :     ("--font" 1 x-handle-switch font)
     190             :     ("--fullscreen" 0 x-handle-initial-switch fullscreen fullboth)
     191             :     ("--fullwidth" 0 x-handle-initial-switch fullscreen fullwidth)
     192             :     ("--fullheight" 0 x-handle-initial-switch fullscreen fullheight)
     193             :     ("--maximized" 0 x-handle-initial-switch fullscreen maximized)
     194             :     ("--internal-border" 1 x-handle-numeric-switch internal-border-width)
     195             :     ("--geometry" 1 x-handle-geometry)
     196             :     ("--foreground-color" 1 x-handle-switch foreground-color)
     197             :     ("--background-color" 1 x-handle-switch background-color)
     198             :     ("--mouse-color" 1 x-handle-switch mouse-color)
     199             :     ("--no-bitmap-icon" 0 x-handle-no-bitmap-icon)
     200             :     ("--iconic" 0 x-handle-iconic)
     201             :     ("--xrm" 1 x-handle-xrm-switch)
     202             :     ("--cursor-color" 1 x-handle-switch cursor-color)
     203             :     ("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t)
     204             :     ("--line-spacing" 1 x-handle-numeric-switch line-spacing)
     205             :     ("--border-color" 1 x-handle-switch border-color)
     206             :     ("--smid" 1 x-handle-smid)
     207             :     ("--parent-id" 1 x-handle-parent-id))
     208             :   "Alist of X Windows options.
     209             : Each element has the form
     210             :   (NAME NUMARGS HANDLER FRAME-PARAM VALUE)
     211             : where NAME is the option name string, NUMARGS is the number of arguments
     212             : that the option accepts, HANDLER is a function to call to handle the option.
     213             : FRAME-PARAM (optional) is the frame parameter this option specifies,
     214             : and VALUE is the value which is given to that frame parameter
     215             : \(most options use the argument for this, so VALUE is not present).")
     216             : 
     217             : (defconst command-line-ns-option-alist
     218             :   '(("-NSAutoLaunch" 1 ns-ignore-1-arg)
     219             :     ("-NXAutoLaunch" 1 ns-ignore-1-arg)
     220             :     ("-macosx" 0 ignore)
     221             :     ("-NSHost" 1 ns-ignore-1-arg)
     222             :     ("-_NSMachLaunch" 1 ns-ignore-1-arg)
     223             :     ("-MachLaunch" 1 ns-ignore-1-arg)
     224             :     ("-NXOpen" 1 ns-ignore-1-arg)
     225             :     ("-NSOpen" 1 ns-handle-nxopen)
     226             :     ("-NXOpenTemp" 1 ns-ignore-1-arg)
     227             :     ("-NSOpenTemp" 1 ns-handle-nxopentemp)
     228             :     ("-GSFilePath" 1 ns-handle-nxopen)
     229             :     ;;("-bw" .              x-handle-numeric-switch)
     230             :     ;;("-d" .               x-handle-display)
     231             :     ;;("-display" .         x-handle-display)
     232             :     ("-name" 1 x-handle-name-switch)
     233             :     ("-title" 1 x-handle-switch title)
     234             :     ("-T" 1 x-handle-switch title)
     235             :     ("-r" 0 x-handle-switch reverse t)
     236             :     ("-rv" 0 x-handle-switch reverse t)
     237             :     ("-reverse" 0 x-handle-switch reverse t)
     238             :     ("-fn" 1 x-handle-switch font)
     239             :     ("-font" 1 x-handle-switch font)
     240             :     ("-ib" 1 x-handle-numeric-switch internal-border-width)
     241             :     ("-g" 1 x-handle-geometry)
     242             :     ("-geometry" 1 x-handle-geometry)
     243             :     ("-fg" 1 x-handle-switch foreground-color)
     244             :     ("-foreground" 1 x-handle-switch foreground-color)
     245             :     ("-bg" 1 x-handle-switch background-color)
     246             :     ("-background" 1 x-handle-switch background-color)
     247             : ;    ("-ms" 1 x-handle-switch mouse-color)
     248             :     ("-itype" 0 x-handle-switch icon-type t)
     249             :     ("-i" 0 x-handle-switch icon-type t)
     250             :     ("-iconic" 0 x-handle-iconic icon-type t)
     251             :     ;;("-xrm" .             x-handle-xrm-switch)
     252             :     ("-cr" 1 x-handle-switch cursor-color)
     253             :     ("-vb" 0 x-handle-switch vertical-scroll-bars t)
     254             :     ("-hb" 0 x-handle-switch horizontal-scroll-bars t)
     255             :     ("-bd" 1 x-handle-switch)
     256             :     ;; ("--border-width" 1 x-handle-numeric-switch border-width)
     257             :     ;; ("--display" 1 ns-handle-display)
     258             :     ("--name" 1 x-handle-name-switch)
     259             :     ("--title" 1 x-handle-switch title)
     260             :     ("--reverse-video" 0 x-handle-switch reverse t)
     261             :     ("--font" 1 x-handle-switch font)
     262             :     ("--internal-border" 1 x-handle-numeric-switch internal-border-width)
     263             :     ;; ("--geometry" 1 ns-handle-geometry)
     264             :     ("--foreground-color" 1 x-handle-switch foreground-color)
     265             :     ("--background-color" 1 x-handle-switch background-color)
     266             :     ("--mouse-color" 1 x-handle-switch mouse-color)
     267             :     ("--icon-type" 0 x-handle-switch icon-type t)
     268             :     ("--iconic" 0 x-handle-iconic)
     269             :     ;; ("--xrm" 1 ns-handle-xrm-switch)
     270             :     ("--cursor-color" 1 x-handle-switch cursor-color)
     271             :     ("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t)
     272             :     ("--border-color" 1 x-handle-switch border-width))
     273             :   "Alist of NS options.
     274             : Each element has the form
     275             :   (NAME NUMARGS HANDLER FRAME-PARAM VALUE)
     276             : where NAME is the option name string, NUMARGS is the number of arguments
     277             : that the option accepts, HANDLER is a function to call to handle the option.
     278             : FRAME-PARAM (optional) is the frame parameter this option specifies,
     279             : and VALUE is the value which is given to that frame parameter
     280             : \(most options use the argument for this, so VALUE is not present).")
     281             : 
     282             : 
     283             : (defvar before-init-hook nil
     284             :   "Normal hook run after handling urgent options but before loading init files.")
     285             : 
     286             : (defvar after-init-hook nil
     287             :   "Normal hook run after initializing the Emacs session.
     288             : It is run after Emacs loads the init file, `default' library, the
     289             : abbrevs file, and additional Lisp packages (if any), and setting
     290             : the value of `after-init-time'.
     291             : 
     292             : There is no `condition-case' around the running of this hook;
     293             : therefore, if `debug-on-error' is non-nil, an error in one of
     294             : these functions will invoke the debugger.")
     295             : 
     296             : (defvar emacs-startup-hook nil
     297             :   "Normal hook run after loading init files and handling the command line.")
     298             : 
     299             : (defvar term-setup-hook nil
     300             :   "Normal hook run immediately after `emacs-startup-hook'.
     301             : In new code, there is no reason to use this instead of `emacs-startup-hook'.
     302             : If you want to execute terminal-specific Lisp code, for example
     303             : to override the definitions made by the terminal-specific file,
     304             : see `tty-setup-hook'.")
     305             : 
     306             : (make-obsolete-variable 'term-setup-hook
     307             :                         "use either `emacs-startup-hook' or \
     308             : `tty-setup-hook' instead." "24.4")
     309             : 
     310             : (defvar inhibit-startup-hooks nil
     311             :   "Non-nil means don't run some startup hooks, because we already did.
     312             : Currently this applies to: `emacs-startup-hook', `term-setup-hook',
     313             : and `window-setup-hook'.")
     314             : 
     315             : (defvar keyboard-type nil
     316             :   "The brand of keyboard you are using.
     317             : This variable is used to define the proper function and keypad
     318             : keys for use under X.  It is used in a fashion analogous to the
     319             : environment variable TERM.")
     320             : 
     321             : (defvar window-setup-hook nil
     322             :   "Normal hook run after loading init files and handling the command line.
     323             : This is very similar to `emacs-startup-hook'.  The only difference
     324             : is that this hook runs after frame parameters have been set up in
     325             : response to any settings from your init file.  Unless this matters
     326             : to you, use `emacs-startup-hook' instead.  (The name of this hook
     327             : is due to historical reasons, and does not reflect its purpose very well.)")
     328             : 
     329             : (defcustom initial-major-mode 'lisp-interaction-mode
     330             :   "Major mode command symbol to use for the initial `*scratch*' buffer."
     331             :   :type 'function
     332             :   :group 'initialization)
     333             : 
     334             : (defvar init-file-user nil
     335             :   "Identity of user whose init file is or was read.
     336             : The value is nil if `-q' or `--no-init-file' was specified,
     337             : meaning do not load any init file.
     338             : 
     339             : Otherwise, the value may be an empty string, meaning
     340             : use the init file for the user who originally logged in,
     341             : or it may be a string containing a user's name meaning
     342             : use that person's init file.
     343             : 
     344             : In either of the latter cases, `(concat \"~\" init-file-user \"/\")'
     345             : evaluates to the name of the directory where the init file was
     346             : looked for.
     347             : 
     348             : Setting `init-file-user' does not prevent Emacs from loading
     349             : `site-start.el'.  The only way to do that is to use `--no-site-file'.")
     350             : 
     351             : (defcustom site-run-file (purecopy "site-start")
     352             :   "File containing site-wide run-time initializations.
     353             : This file is loaded at run-time before `~/.emacs'.  It contains inits
     354             : that need to be in place for the entire site, but which, due to their
     355             : higher incidence of change, don't make sense to load into Emacs's
     356             : dumped image.  Thus, the run-time load order is: 1. file described in
     357             : this variable, if non-nil; 2. `~/.emacs'; 3. `default.el'.
     358             : 
     359             : Don't use the `site-start.el' file for things some users may not like.
     360             : Put them in `default.el' instead, so that users can more easily
     361             : override them.  Users can prevent loading `default.el' with the `-q'
     362             : option or by setting `inhibit-default-init' in their own init files,
     363             : but inhibiting `site-start.el' requires `--no-site-file', which
     364             : is less convenient.
     365             : 
     366             : This variable is defined for customization so as to make
     367             : it visible in the relevant context.  However, actually customizing it
     368             : is not allowed, since it would not work anyway.  The only way to set
     369             : this variable usefully is to set it while building and dumping Emacs."
     370             :   :type '(choice (const :tag "none" nil) string)
     371             :   :group 'initialization
     372             :   :initialize #'custom-initialize-default
     373             :   :set (lambda (_variable _value)
     374             :           (error "Customizing `site-run-file' does not work")))
     375             : 
     376             : (make-obsolete-variable 'system-name "use (system-name) instead" "25.1")
     377             : 
     378             : (defcustom mail-host-address nil
     379             :   "The name of this machine, for use in constructing email addresses.
     380             : If this is nil, Emacs uses `system-name'."
     381             :   :type '(choice (const nil) string)
     382             :   :group 'mail)
     383             : 
     384             : (defcustom user-mail-address
     385             :   (or (getenv "EMAIL")
     386             :       (concat (user-login-name) "@" (or mail-host-address (system-name))))
     387             :   "The email address of the current user.
     388             : This defaults to either: the value of EMAIL environment variable; or
     389             : user@host, using `user-login-name' and `mail-host-address' (or `system-name')."
     390             :   :initialize 'custom-initialize-delay
     391             :   :set-after '(mail-host-address)
     392             :   :type 'string
     393             :   :group 'mail)
     394             : 
     395             : (defcustom auto-save-list-file-prefix
     396             :   (cond ((eq system-type 'ms-dos)
     397             :          ;; MS-DOS cannot have initial dot, and allows only 8.3 names
     398             :          (concat user-emacs-directory "auto-save.list/_s"))
     399             :         (t
     400             :          (concat user-emacs-directory "auto-save-list/.saves-")))
     401             :   "Prefix for generating `auto-save-list-file-name'.
     402             : This is used after reading your init file to initialize
     403             : `auto-save-list-file-name', by appending Emacs's pid and the system name,
     404             : if you have not already set `auto-save-list-file-name' yourself.
     405             : Directories in the prefix will be created if necessary.
     406             : Set this to nil if you want to prevent `auto-save-list-file-name'
     407             : from being initialized."
     408             :   :type '(choice (const :tag "Don't record a session's auto save list" nil)
     409             :                  string)
     410             :   :group 'auto-save)
     411             : 
     412             : (defvar emacs-basic-display nil)
     413             : 
     414             : (defvar init-file-debug nil)
     415             : 
     416             : (defvar init-file-had-error nil
     417             :   "Non-nil if there was an error loading the user's init file.")
     418             : 
     419             : (defvar normal-top-level-add-subdirs-inode-list nil)
     420             : 
     421             : (defvar no-blinking-cursor nil)
     422             : 
     423             : (defvar pure-space-overflow nil
     424             :   "Non-nil if building Emacs overflowed pure space.")
     425             : 
     426             : (defvar pure-space-overflow-message (purecopy "\
     427             : Warning Warning!!!  Pure space overflow    !!!Warning Warning
     428             : \(See the node Pure Storage in the Lisp manual for details.)\n"))
     429             : 
     430             : (defcustom tutorial-directory
     431             :   (file-name-as-directory (expand-file-name "tutorials" data-directory))
     432             :   "Directory containing the Emacs TUTORIAL files."
     433             :   :group 'installation
     434             :   :type 'directory
     435             :   :initialize #'custom-initialize-delay)
     436             : 
     437             : (defun normal-top-level-add-subdirs-to-load-path ()
     438             :   "Recursively add all subdirectories of `default-directory' to `load-path'.
     439             : More precisely, this uses only the subdirectories whose names
     440             : start with letters or digits; it excludes any subdirectory named `RCS'
     441             : or `CVS', and any subdirectory that contains a file named `.nosearch'."
     442           0 :   (let (dirs
     443             :         attrs
     444           0 :         (pending (list default-directory)))
     445             :     ;; This loop does a breadth-first tree walk on DIR's subtree,
     446             :     ;; putting each subdir into DIRS as its contents are examined.
     447           0 :     (while pending
     448           0 :       (push (pop pending) dirs)
     449           0 :       (let* ((this-dir (car dirs))
     450           0 :              (contents (directory-files this-dir))
     451           0 :              (default-directory this-dir)
     452           0 :              (canonicalized (if (fboundp 'w32-untranslated-canonical-name)
     453           0 :                                 (w32-untranslated-canonical-name this-dir))))
     454             :         ;; The Windows version doesn't report meaningful inode numbers, so
     455             :         ;; use the canonicalized absolute file name of the directory instead.
     456           0 :         (setq attrs (or canonicalized
     457           0 :                         (nthcdr 10 (file-attributes this-dir))))
     458           0 :         (unless (member attrs normal-top-level-add-subdirs-inode-list)
     459           0 :           (push attrs normal-top-level-add-subdirs-inode-list)
     460           0 :           (dolist (file contents)
     461           0 :             (and (string-match "\\`[[:alnum:]]" file)
     462             :                  ;; The lower-case variants of RCS and CVS are for DOS/Windows.
     463           0 :                  (not (member file '("RCS" "CVS" "rcs" "cvs")))
     464             :                  ;; Avoid doing a `stat' when it isn't necessary because
     465             :                  ;; that can cause trouble when an NFS server is down.
     466           0 :                  (not (string-match "\\.elc?\\'" file))
     467           0 :                  (file-directory-p file)
     468           0 :                  (let ((expanded (expand-file-name file)))
     469           0 :                    (or (file-exists-p (expand-file-name ".nosearch" expanded))
     470           0 :                        (setq pending (nconc pending (list expanded))))))))))
     471           0 :     (normal-top-level-add-to-load-path (cdr (nreverse dirs)))))
     472             : 
     473             : (defun normal-top-level-add-to-load-path (dirs)
     474             :   "This function is called from a subdirs.el file.
     475             : It assumes that `default-directory' is the directory in which the
     476             : subdirs.el file exists, and it adds to `load-path' the subdirs of
     477             : that directory as specified in DIRS.  Normally the elements of
     478             : DIRS are relative."
     479           1 :   (let ((tail load-path)
     480           1 :         (thisdir (directory-file-name default-directory)))
     481           1 :     (while (and tail
     482             :                 ;;Don't go all the way to the nil terminator.
     483           1 :                 (cdr tail)
     484           1 :                 (not (equal thisdir (car tail)))
     485           0 :                 (not (and (memq system-type '(ms-dos windows-nt))
     486           1 :                           (equal (downcase thisdir) (downcase (car tail))))))
     487           1 :       (setq tail (cdr tail)))
     488             :     ;;Splice the new section in.
     489           1 :     (when tail
     490           1 :       (setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail))))))
     491             : 
     492             : (defun normal-top-level ()
     493             :   "Emacs calls this function when it first starts up.
     494             : It sets `command-line-processed', processes the command-line,
     495             : reads the initialization files, etc.
     496             : It is the default value of the variable `top-level'."
     497           0 :   (if command-line-processed
     498           0 :       (message internal--top-level-message)
     499           0 :     (setq command-line-processed t)
     500             : 
     501             :     ;; Look in each dir in load-path for a subdirs.el file.  If we
     502             :     ;; find one, load it, which will add the appropriate subdirs of
     503             :     ;; that dir into load-path.  This needs to be done before setting
     504             :     ;; the locale environment, because the latter might need to load
     505             :     ;; some support files.
     506             :     ;; Look for a leim-list.el file too.  Loading it will register
     507             :     ;; available input methods.
     508           0 :     (let ((tail load-path)
     509           0 :           (lispdir (expand-file-name "../lisp" data-directory))
     510             :           dir)
     511           0 :       (while tail
     512           0 :         (setq dir (car tail))
     513           0 :         (let ((default-directory dir))
     514           0 :           (load (expand-file-name "subdirs.el") t t t))
     515             :         ;; Do not scan standard directories that won't contain a leim-list.el.
     516             :         ;; http://lists.gnu.org/archive/html/emacs-devel/2009-10/msg00502.html
     517             :         ;; (Except the preloaded one in lisp/leim.)
     518           0 :         (or (string-prefix-p lispdir dir)
     519           0 :             (let ((default-directory dir))
     520           0 :               (load (expand-file-name "leim-list.el") t t t)))
     521             :         ;; We don't use a dolist loop and we put this "setq-cdr" command at
     522             :         ;; the end, because the subdirs.el files may add elements to the end
     523             :         ;; of load-path and we want to take it into account.
     524           0 :         (setq tail (cdr tail))))
     525             : 
     526             :     ;; Set the default strings to display in mode line for end-of-line
     527             :     ;; formats that aren't native to this platform.  This should be
     528             :     ;; done before calling set-locale-environment, as the latter might
     529             :     ;; use these mnemonics.
     530           0 :     (cond
     531           0 :      ((memq system-type '(ms-dos windows-nt))
     532           0 :       (setq eol-mnemonic-unix "(Unix)"
     533           0 :             eol-mnemonic-mac  "(Mac)"))
     534             :      (t                                   ; this is for Unix/GNU/Linux systems
     535           0 :       (setq eol-mnemonic-dos  "(DOS)"
     536           0 :             eol-mnemonic-mac  "(Mac)")))
     537             : 
     538           0 :     (set-locale-environment nil)
     539             :     ;; Decode all default-directory's (probably, only *scratch* exists
     540             :     ;; at this point).  default-directory of *scratch* is the basis
     541             :     ;; for many other file-name variables and directory lists, so it
     542             :     ;; is important to decode it ASAP.
     543           0 :     (when locale-coding-system
     544           0 :       (let ((coding (if (eq system-type 'windows-nt)
     545             :                         ;; MS-Windows build converts all file names to
     546             :                         ;; UTF-8 during startup.
     547             :                         'utf-8
     548           0 :                       locale-coding-system)))
     549           0 :         (save-excursion
     550           0 :           (dolist (elt (buffer-list))
     551           0 :             (set-buffer elt)
     552           0 :             (if default-directory
     553           0 :                 (setq default-directory
     554           0 :                       (if (eq system-type 'windows-nt)
     555             :                           ;; Convert backslashes to forward slashes.
     556           0 :                           (expand-file-name
     557           0 :                            (decode-coding-string default-directory coding t))
     558           0 :                         (decode-coding-string default-directory coding t))))))
     559             : 
     560             :         ;; Decode all the important variables and directory lists, now
     561             :         ;; that we know the locale's encoding.  This is because the
     562             :         ;; values of these variables are until here unibyte undecoded
     563             :         ;; strings created by build_unibyte_string.  data-directory in
     564             :         ;; particular is used to construct many other standard
     565             :         ;; directory names, so it must be decoded ASAP.  Note that
     566             :         ;; charset-map-path cannot be decoded here, since we could
     567             :         ;; then be trapped in infinite recursion below, when we load
     568             :         ;; subdirs.el, because encoding a directory name might need to
     569             :         ;; load a charset map, which will want to encode
     570             :         ;; charset-map-path, which will want to load the same charset
     571             :         ;; map...  So decoding of charset-map-path is delayed until
     572             :         ;; further down below.
     573           0 :         (dolist (pathsym '(load-path exec-path))
     574           0 :           (let ((path (symbol-value pathsym)))
     575           0 :             (if (listp path)
     576           0 :                 (set pathsym (mapcar (lambda (dir)
     577           0 :                                        (decode-coding-string dir coding t))
     578           0 :                                      path)))))
     579           0 :         (dolist (filesym '(data-directory doc-directory exec-directory
     580             :                                           installation-directory
     581             :                                           invocation-directory invocation-name
     582             :                                           source-directory
     583             :                                           shared-game-score-directory))
     584           0 :           (let ((file (symbol-value filesym)))
     585           0 :             (if (stringp file)
     586           0 :                 (set filesym (decode-coding-string file coding t)))))))
     587             : 
     588           0 :     (let ((dir default-directory))
     589           0 :       (with-current-buffer "*Messages*"
     590           0 :         (messages-buffer-mode)
     591             :         ;; Make it easy to do like "tail -f".
     592           0 :         (set (make-local-variable 'window-point-insertion-type) t)
     593             :         ;; Give *Messages* the same default-directory as *scratch*,
     594             :         ;; just to keep things predictable.
     595           0 :         (setq default-directory (or dir (expand-file-name "~/")))))
     596             :     ;; `user-full-name' is now known; reset its standard-value here.
     597           0 :     (put 'user-full-name 'standard-value
     598           0 :          (list (default-value 'user-full-name)))
     599             :     ;; If the PWD environment variable isn't accurate, delete it.
     600           0 :     (let ((pwd (getenv "PWD")))
     601           0 :       (and (stringp pwd)
     602             :            ;; Use FOO/., so that if FOO is a symlink, file-attributes
     603             :            ;; describes the directory linked to, not FOO itself.
     604           0 :            (or (and default-directory
     605           0 :                     (equal (file-attributes
     606           0 :                        (concat (file-name-as-directory pwd) "."))
     607           0 :                       (file-attributes
     608           0 :                        (concat (file-name-as-directory default-directory)
     609           0 :                                "."))))
     610           0 :                (setq process-environment
     611           0 :                      (delete (concat "PWD=" pwd)
     612           0 :                              process-environment)))))
     613             :     ;; Now, that other directories were searched, and any charsets we
     614             :     ;; need for encoding them are already loaded, we are ready to
     615             :     ;; decode charset-map-path.
     616           0 :     (if (listp charset-map-path)
     617           0 :         (let ((coding (if (eq system-type 'windows-nt)
     618             :                           'utf-8
     619           0 :                         locale-coding-system)))
     620           0 :           (setq charset-map-path
     621           0 :                 (mapcar (lambda (dir)
     622           0 :                           (decode-coding-string dir coding t))
     623           0 :                         charset-map-path))))
     624           0 :     (if default-directory
     625           0 :         (setq default-directory (abbreviate-file-name default-directory))
     626           0 :       (display-warning 'initialization "Error setting default-directory"))
     627           0 :     (let ((old-face-font-rescale-alist face-font-rescale-alist))
     628           0 :       (unwind-protect
     629           0 :           (command-line)
     630             :         ;; Do this again, in case .emacs defined more abbreviations.
     631           0 :         (if default-directory
     632           0 :             (setq default-directory (abbreviate-file-name default-directory)))
     633             :         ;; Specify the file for recording all the auto save files of this session.
     634             :         ;; This is used by recover-session.
     635           0 :         (or auto-save-list-file-name
     636           0 :             (and auto-save-list-file-prefix
     637           0 :                  (setq auto-save-list-file-name
     638             :                        ;; Under MS-DOS our PID is almost always reused between
     639             :                        ;; Emacs invocations.  We need something more unique.
     640           0 :                        (cond ((eq system-type 'ms-dos)
     641             :                               ;; We are going to access the auto-save
     642             :                               ;; directory, so make sure it exists.
     643           0 :                               (make-directory
     644           0 :                                (file-name-directory auto-save-list-file-prefix)
     645           0 :                                t)
     646           0 :                               (concat
     647           0 :                                (make-temp-name
     648           0 :                                 (expand-file-name
     649           0 :                                  auto-save-list-file-prefix))
     650           0 :                                "~"))
     651             :                              (t
     652           0 :                               (expand-file-name
     653           0 :                                (format "%s%d-%s~"
     654           0 :                                        auto-save-list-file-prefix
     655           0 :                                        (emacs-pid)
     656           0 :                                        (system-name))))))))
     657           0 :         (unless inhibit-startup-hooks
     658           0 :           (run-hooks 'emacs-startup-hook 'term-setup-hook))
     659             : 
     660             :         ;; Don't do this if we failed to create the initial frame,
     661             :         ;; for instance due to a dense colormap.
     662           0 :         (when (or frame-initial-frame
     663             :                   ;; If frame-initial-frame has no meaning, do this anyway.
     664           0 :                   (not (and initial-window-system
     665           0 :                             (not noninteractive)
     666           0 :                             (not (eq initial-window-system 'pc)))))
     667             : 
     668             :           ;; FIXME: The user's init file may change
     669             :           ;; face-font-rescale-alist.  However, the default face
     670             :           ;; already has an assigned font object, which does not take
     671             :           ;; face-font-rescale-alist into account.  For such
     672             :           ;; situations, we ought to have a way to find all font
     673             :           ;; objects and regenerate them; currently we do not.  As a
     674             :           ;; workaround, we specifically reset te default face's :font
     675             :           ;; attribute here.  See bug#1785.
     676           0 :           (unless (eq face-font-rescale-alist
     677           0 :                       old-face-font-rescale-alist)
     678           0 :             (set-face-attribute 'default nil :font (font-spec)))
     679             : 
     680             :           ;; Modify the initial frame based on what .emacs puts into
     681             :           ;; ...-frame-alist.
     682           0 :           (if (fboundp 'frame-notice-user-settings)
     683           0 :               (frame-notice-user-settings))
     684             :           ;; Set the faces for the initial background mode even if
     685             :           ;; frame-notice-user-settings didn't (such as on a tty).
     686             :           ;; frame-set-background-mode is idempotent, so it won't
     687             :           ;; cause any harm if it's already been done.
     688           0 :           (if (fboundp 'frame-set-background-mode)
     689           0 :               (frame-set-background-mode (selected-frame))))
     690             : 
     691             :         ;; Now we know the user's default font, so add it to the menu.
     692           0 :         (if (fboundp 'font-menu-add-default)
     693           0 :             (font-menu-add-default))
     694           0 :         (unless inhibit-startup-hooks
     695           0 :           (run-hooks 'window-setup-hook))))
     696             :     ;; Subprocesses of Emacs do not have direct access to the terminal, so
     697             :     ;; unless told otherwise they should only assume a dumb terminal.
     698             :     ;; We are careful to do it late (after term-setup-hook), although the
     699             :     ;; new multi-tty code does not use $TERM any more there anyway.
     700           0 :     (setenv "TERM" "dumb")
     701             :     ;; Remove DISPLAY from the process-environment as well.  This allows
     702             :     ;; `callproc.c' to give it a useful adaptive default which is either
     703             :     ;; the value of the `display' frame-parameter or the DISPLAY value
     704             :     ;; from initial-environment.
     705           0 :     (let ((display (frame-parameter nil 'display)))
     706             :       ;; Be careful which DISPLAY to remove from process-environment: follow
     707             :       ;; the logic of `callproc.c'.
     708           0 :       (if (stringp display) (setq display (concat "DISPLAY=" display))
     709           0 :         (dolist (varval initial-environment)
     710           0 :           (if (string-match "\\`DISPLAY=" varval)
     711           0 :               (setq display varval))))
     712           0 :       (when display
     713           0 :         (delete display process-environment)))))
     714             : 
     715             : ;; Precompute the keyboard equivalents in the menu bar items.
     716             : ;; Command-line options supported by tty's:
     717             : (defconst tty-long-option-alist
     718             :   '(("--name"           . "-name")
     719             :     ("--title"                  . "-T")
     720             :     ("--reverse-video"          . "-reverse")
     721             :     ("--foreground-color" . "-fg")
     722             :     ("--background-color" . "-bg")
     723             :     ("--color"                  . "-color")))
     724             : 
     725             : (defconst tool-bar-images-pixel-height 24
     726             :   "Height in pixels of images in the tool-bar.")
     727             : 
     728             : (cl-defgeneric handle-args-function (args)
     729             :   "Method for processing window-system dependent command-line arguments.
     730             : Window system startup files should add their own function to this
     731             : method, which should parse the command line arguments.  Those
     732             : pertaining to the window system should be processed and removed
     733             : from the returned command line.")
     734             : (cl-defmethod handle-args-function (args &context (window-system nil))
     735           0 :   (tty-handle-args args))
     736             : 
     737             : (cl-defgeneric window-system-initialization (&optional _display)
     738             :   "Method for window-system initialization.
     739             : Window-system startup files should add their own implementation
     740             : to this method.  The function should initialize the window system environment
     741             : to prepare for opening the first frame (e.g. open a connection to an X server)."
     742             :   nil)
     743             : 
     744             : (defun tty-handle-args (args)
     745             :   "Handle the X-like command-line arguments \"-fg\", \"-bg\", \"-name\", etc."
     746           0 :   (let (rest)
     747           0 :     (while (and args
     748           0 :                 (not (equal (car args) "--")))
     749           0 :       (let* ((argi (pop args))
     750           0 :              (orig-argi argi)
     751             :              argval completion)
     752             :         ;; Check for long options with attached arguments
     753             :         ;; and separate out the attached option argument into argval.
     754           0 :         (when (string-match "^\\(--[^=]*\\)=" argi)
     755           0 :           (setq argval (substring argi (match-end 0))
     756           0 :                 argi (match-string 1 argi)))
     757           0 :         (when (string-match "^--" argi)
     758           0 :           (setq completion (try-completion argi tty-long-option-alist))
     759           0 :           (if (eq completion t)
     760             :               ;; Exact match for long option.
     761           0 :               (setq argi (cdr (assoc argi tty-long-option-alist)))
     762           0 :             (if (stringp completion)
     763           0 :                 (let ((elt (assoc completion tty-long-option-alist)))
     764             :                   ;; Check for abbreviated long option.
     765           0 :                   (or elt
     766           0 :                       (error "Option `%s' is ambiguous" argi))
     767           0 :                   (setq argi (cdr elt)))
     768             :               ;; Check for a short option.
     769           0 :               (setq argval nil
     770           0 :                     argi orig-argi))))
     771           0 :         (cond ((member argi '("-fg" "-foreground"))
     772           0 :                (push (cons 'foreground-color (or argval (pop args)))
     773           0 :                      default-frame-alist))
     774           0 :               ((member argi '("-bg" "-background"))
     775           0 :                (push (cons 'background-color (or argval (pop args)))
     776           0 :                      default-frame-alist))
     777           0 :               ((member argi '("-T" "-name"))
     778           0 :                (unless argval (setq argval (pop args)))
     779           0 :                (push (cons 'title
     780           0 :                            (if (stringp argval)
     781           0 :                                argval
     782           0 :                              (let ((case-fold-search t)
     783             :                                    i)
     784           0 :                                (setq argval (invocation-name))
     785             : 
     786             :                                ;; Change any . or * characters in name to
     787             :                                ;; hyphens, so as to emulate behavior on X.
     788           0 :                                (while
     789           0 :                                    (setq i (string-match "[.*]" argval))
     790           0 :                                  (aset argval i ?-))
     791           0 :                                argval)))
     792           0 :                      default-frame-alist))
     793           0 :               ((member argi '("-r" "-rv" "-reverse"))
     794           0 :                (push '(reverse . t)
     795           0 :                      default-frame-alist))
     796           0 :               ((equal argi "-color")
     797           0 :                (unless argval (setq argval 8)) ; default --color means 8 ANSI colors
     798           0 :                (push (cons 'tty-color-mode
     799           0 :                            (cond
     800           0 :                             ((numberp argval) argval)
     801           0 :                             ((string-match "-?[0-9]+" argval)
     802           0 :                              (string-to-number argval))
     803           0 :                             (t (intern argval))))
     804           0 :                      default-frame-alist))
     805             :               (t
     806           0 :                (push argi rest)))))
     807           0 :     (nconc (nreverse rest) args)))
     808             : 
     809             : (declare-function x-get-resource "frame.c"
     810             :                   (attribute class &optional component subclass))
     811             : (declare-function tool-bar-mode "tool-bar" (&optional arg))
     812             : (declare-function tool-bar-setup "tool-bar")
     813             : 
     814             : (defvar server-name)
     815             : (defvar server-process)
     816             : 
     817             : (defun startup--setup-quote-display (&optional style)
     818             :   "If needed, display ASCII approximations to curved quotes.
     819             : Do this by modifying `standard-display-table'.  Optional STYLE
     820             : specifies the desired quoting style, as in `text-quoting-style'.
     821             : If STYLE is nil, display appropriately for the terminal."
     822           0 :   (let ((repls (let ((style-repls (assq style '((grave . "`'\"\"")
     823           0 :                                                 (straight . "''\"\"")))))
     824           0 :                  (if style-repls (cdr style-repls) (make-vector 4 nil))))
     825             :         glyph-count)
     826             :     ;; REPLS is a sequence of the four replacements for "‘’“”", respectively.
     827             :     ;; If STYLE is nil, infer REPLS from terminal characteristics.
     828           0 :     (unless style
     829             :       ;; On a terminal that supports glyph codes,
     830             :       ;; GLYPH-COUNT[i] is the number of times that glyph code I
     831             :       ;; represents either an ASCII character or one of the 4
     832             :       ;; quote characters.  This assumes glyph codes are valid
     833             :       ;; Elisp characters, which is a safe assumption in practice.
     834           0 :       (when (integerp (internal-char-font nil (max-char)))
     835           0 :         (setq glyph-count (make-char-table nil 0))
     836           0 :         (dotimes (i 132)
     837           0 :           (let ((glyph (internal-char-font
     838           0 :                         nil (if (< i 128) i (aref "‘’“”" (- i 128))))))
     839           0 :             (when (<= 0 glyph)
     840           0 :               (aset glyph-count glyph (1+ (aref glyph-count glyph)))))))
     841           0 :       (dotimes (i 2)
     842           0 :         (let ((lq (aref "‘“" i)) (rq (aref "’”" i))
     843           0 :               (lr (aref "`\"" i)) (rr (aref "'\"" i))
     844           0 :               (i2 (* i 2)))
     845           0 :           (unless (if glyph-count
     846             :                       ;; On a terminal that supports glyph codes, use
     847             :                       ;; ASCII replacements unless both quotes are displayable.
     848             :                       ;; If not using ASCII replacements, highlight
     849             :                       ;; quotes unless they are both unique among the
     850             :                       ;; 128 + 4 characters of concern.
     851           0 :                       (let ((lglyph (internal-char-font nil lq))
     852           0 :                             (rglyph (internal-char-font nil rq)))
     853           0 :                         (when (and (<= 0 lglyph) (<= 0 rglyph))
     854           0 :                           (setq lr lq rr rq)
     855           0 :                           (and (= 1 (aref glyph-count lglyph))
     856           0 :                                (= 1 (aref glyph-count rglyph)))))
     857             :                     ;; On a terminal that does not support glyph codes, use
     858             :                     ;; ASCII replacements unless both quotes are displayable.
     859           0 :                     (and (char-displayable-p lq)
     860           0 :                          (char-displayable-p rq)))
     861           0 :             (aset repls i2 lr)
     862           0 :             (aset repls (1+ i2) rr)))))
     863           0 :     (dotimes (i 4)
     864           0 :       (let ((char (aref "‘’“”" i))
     865           0 :             (repl (aref repls i)))
     866           0 :         (if repl
     867           0 :             (aset (or standard-display-table
     868           0 :                       (setq standard-display-table (make-display-table)))
     869           0 :                   char (vector (make-glyph-code repl 'homoglyph)))
     870           0 :           (when standard-display-table
     871           0 :             (aset standard-display-table char nil)))))))
     872             : 
     873             : (defun command-line ()
     874             :   "A subroutine of `normal-top-level'.
     875             : Amongst another things, it parses the command-line arguments."
     876           0 :   (setq before-init-time (current-time)
     877             :         after-init-time nil
     878           0 :         command-line-default-directory default-directory)
     879             : 
     880             :   ;; Force recomputation, in case it was computed during the dump.
     881           0 :   (setq abbreviated-home-dir nil)
     882             : 
     883             :   ;; See if we should import version-control from the environment variable.
     884           0 :   (let ((vc (getenv "VERSION_CONTROL")))
     885           0 :     (cond ((eq vc nil))                 ;don't do anything if not set
     886           0 :           ((member vc '("t" "numbered"))
     887           0 :            (setq version-control t))
     888           0 :           ((member vc '("nil" "existing"))
     889           0 :            (setq version-control nil))
     890           0 :           ((member vc '("never" "simple"))
     891           0 :            (setq version-control 'never))))
     892             : 
     893             :   ;;! This has been commented out; I currently find the behavior when
     894             :   ;;! split-window-keep-point is nil disturbing, but if I can get used
     895             :   ;;! to it, then it would be better to eliminate the option.
     896             :   ;;! ;; Choose a good default value for split-window-keep-point.
     897             :   ;;! (setq split-window-keep-point (> baud-rate 2400))
     898             : 
     899             :   ;; Convert preloaded file names in load-history to absolute.
     900           0 :   (let ((simple-file-name
     901             :          ;; Look for simple.el or simple.elc and use their directory
     902             :          ;; as the place where all Lisp files live.
     903           0 :          (locate-file "simple" load-path (get-load-suffixes)))
     904             :         lisp-dir)
     905             :     ;; Don't abort if simple.el cannot be found, but print a warning.
     906             :     ;; Although in most usage we are going to cryptically abort a moment
     907             :     ;; later anyway, due to missing required bidi data files (eg bug#13430).
     908           0 :     (if (null simple-file-name)
     909           0 :         (let ((standard-output 'external-debugging-output)
     910           0 :               (lispdir (expand-file-name "../lisp" data-directory)))
     911           0 :           (princ "Warning: Could not find simple.el or simple.elc")
     912           0 :           (terpri)
     913           0 :           (when (getenv "EMACSLOADPATH")
     914           0 :             (princ "The EMACSLOADPATH environment variable is set, \
     915           0 : please check its value")
     916           0 :             (terpri))
     917           0 :           (unless (file-readable-p lispdir)
     918           0 :             (princ (format "Lisp directory %s not readable?" lispdir))
     919           0 :             (terpri)))
     920           0 :       (setq lisp-dir (file-truename (file-name-directory simple-file-name)))
     921           0 :       (setq load-history
     922           0 :             (mapcar (lambda (elt)
     923           0 :                       (if (and (stringp (car elt))
     924           0 :                                (not (file-name-absolute-p (car elt))))
     925           0 :                           (cons (concat lisp-dir
     926           0 :                                         (car elt))
     927           0 :                                 (cdr elt))
     928           0 :                         elt))
     929           0 :                     load-history))))
     930             : 
     931             :   ;; Convert the arguments to Emacs internal representation.
     932           0 :   (let ((args command-line-args))
     933           0 :     (while args
     934           0 :       (setcar args
     935           0 :               (decode-coding-string (car args) locale-coding-system t))
     936           0 :       (pop args)))
     937             : 
     938           0 :   (let ((done nil)
     939           0 :         (args (cdr command-line-args))
     940             :         display-arg)
     941             : 
     942             :     ;; Figure out which user's init file to load,
     943             :     ;; either from the environment or from the options.
     944           0 :     (setq init-file-user (if noninteractive nil (user-login-name)))
     945             :     ;; If user has not done su, use current $HOME to find .emacs.
     946           0 :     (and init-file-user
     947           0 :          (equal init-file-user (user-real-login-name))
     948           0 :          (setq init-file-user ""))
     949             : 
     950             :     ;; Process the command-line args, and delete the arguments
     951             :     ;; processed.  This is consistent with the way main in emacs.c
     952             :     ;; does things.
     953           0 :     (while (and (not done) args)
     954           0 :       (let* ((longopts '(("--no-init-file") ("--no-site-file")
     955             :                          ("--no-x-resources") ("--debug-init")
     956             :                          ("--user") ("--iconic") ("--icon-type") ("--quick")
     957             :                          ("--no-blinking-cursor") ("--basic-display")))
     958           0 :              (argi (pop args))
     959           0 :              (orig-argi argi)
     960             :              argval)
     961             :         ;; Handle --OPTION=VALUE format.
     962           0 :         (when (string-match "\\`\\(--[^=]*\\)=" argi)
     963           0 :           (setq argval (substring argi (match-end 0))
     964           0 :                 argi (match-string 1 argi)))
     965           0 :         (when (string-match "\\`--." orig-argi)
     966           0 :           (let ((completion (try-completion argi longopts)))
     967           0 :             (cond ((eq completion t)
     968           0 :                    (setq argi (substring argi 1)))
     969           0 :                   ((stringp completion)
     970           0 :                    (let ((elt (assoc completion longopts)))
     971           0 :                      (unless elt
     972           0 :                        (error "Option `%s' is ambiguous" argi))
     973           0 :                      (setq argi (substring (car elt) 1))))
     974             :                   (t
     975           0 :                    (setq argval nil
     976           0 :                          argi orig-argi)))))
     977           0 :         (cond
     978             :          ;; The --display arg is handled partly in C, partly in Lisp.
     979             :          ;; When it shows up here, we just put it back to be handled
     980             :          ;; by `command-line-1'.
     981           0 :          ((member argi '("-d" "-display"))
     982           0 :           (setq display-arg (list argi (pop args))))
     983           0 :          ((member argi '("-Q" "-quick"))
     984           0 :           (setq init-file-user nil
     985             :                 site-run-file nil
     986           0 :                 inhibit-x-resources t)
     987             :           ;; Stop it showing up in emacs -Q's customize-rogue.
     988           0 :           (put 'site-run-file 'standard-value '(nil)))
     989           0 :          ((member argi '("-no-x-resources"))
     990           0 :           (setq inhibit-x-resources t))
     991           0 :          ((member argi '("-D" "-basic-display"))
     992           0 :           (setq no-blinking-cursor t
     993           0 :                 emacs-basic-display t)
     994           0 :           (push '(vertical-scroll-bars . nil) initial-frame-alist))
     995           0 :          ((member argi '("-q" "-no-init-file"))
     996           0 :           (setq init-file-user nil))
     997           0 :          ((member argi '("-u" "-user"))
     998           0 :           (setq init-file-user (or argval (pop args))
     999           0 :                 argval nil))
    1000           0 :          ((equal argi "-no-site-file")
    1001           0 :           (setq site-run-file nil)
    1002           0 :           (put 'site-run-file 'standard-value '(nil)))
    1003           0 :          ((equal argi "-debug-init")
    1004           0 :           (setq init-file-debug t))
    1005           0 :          ((equal argi "-iconic")
    1006           0 :           (push '(visibility . icon) initial-frame-alist))
    1007           0 :          ((member argi '("-nbc" "-no-blinking-cursor"))
    1008           0 :           (setq no-blinking-cursor t))
    1009             :          ;; Push the popped arg back on the list of arguments.
    1010             :          (t
    1011           0 :           (push argi args)
    1012           0 :           (setq done t)))
    1013             :         ;; Was argval set but not used?
    1014           0 :         (and argval
    1015           0 :              (error "Option `%s' doesn't allow an argument" argi))))
    1016             : 
    1017             :     ;; Re-attach the --display arg.
    1018           0 :     (and display-arg (setq args (append display-arg args)))
    1019             : 
    1020             :     ;; Re-attach the program name to the front of the arg list.
    1021           0 :     (and command-line-args
    1022           0 :          (setcdr command-line-args args)))
    1023             : 
    1024             :   ;; Make sure window system's init file was loaded in loadup.el if
    1025             :   ;; using a window system.
    1026             :   ;; Initialize the window-system only after processing the command-line
    1027             :   ;; args so that -Q can influence this initialization.
    1028           0 :   (condition-case error
    1029           0 :     (unless noninteractive
    1030           0 :       (if (and initial-window-system
    1031           0 :                (not (featurep
    1032           0 :                      (intern
    1033           0 :                       (concat (symbol-name initial-window-system) "-win")))))
    1034           0 :           (error "Unsupported window system `%s'" initial-window-system))
    1035             :       ;; Process window-system specific command line parameters.
    1036           0 :       (setq command-line-args
    1037           0 :             (let ((window-system initial-window-system)) ;Hack attack!
    1038           0 :               (handle-args-function command-line-args)))
    1039             :       ;; Initialize the window system. (Open connection, etc.)
    1040           0 :       (let ((window-system initial-window-system)) ;Hack attack!
    1041           0 :         (window-system-initialization))
    1042           0 :       (put initial-window-system 'window-system-initialized t))
    1043             :     ;; If there was an error, print the error message and exit.
    1044             :     (error
    1045           0 :      (princ
    1046           0 :       (if (eq (car error) 'error)
    1047           0 :           (apply 'concat (cdr error))
    1048           0 :         (if (memq 'file-error (get (car error) 'error-conditions))
    1049           0 :             (format "%s: %s"
    1050           0 :                     (nth 1 error)
    1051           0 :                     (mapconcat (lambda (obj) (prin1-to-string obj t))
    1052           0 :                                (cdr (cdr error)) ", "))
    1053           0 :           (format "%s: %s"
    1054           0 :                   (get (car error) 'error-message)
    1055           0 :                   (mapconcat (lambda (obj) (prin1-to-string obj t))
    1056           0 :                              (cdr error) ", "))))
    1057           0 :       'external-debugging-output)
    1058           0 :      (terpri 'external-debugging-output)
    1059           0 :      (setq initial-window-system nil)
    1060           0 :      (kill-emacs)))
    1061             : 
    1062           0 :   (run-hooks 'before-init-hook)
    1063             : 
    1064             :   ;; Under X, create the X frame and delete the terminal frame.
    1065           0 :   (unless (daemonp)
    1066           0 :     (if (or noninteractive emacs-basic-display)
    1067           0 :         (setq menu-bar-mode nil
    1068             :               tool-bar-mode nil
    1069           0 :               no-blinking-cursor t))
    1070           0 :     (frame-initialize))
    1071             : 
    1072           0 :   (when (fboundp 'x-create-frame)
    1073             :     ;; Set up the tool-bar (even in tty frames, since Emacs might open a
    1074             :     ;; graphical frame later).
    1075           0 :     (unless noninteractive
    1076           0 :       (tool-bar-setup)))
    1077             : 
    1078             :   ;; Turn off blinking cursor if so specified in X resources.  This is here
    1079             :   ;; only because all other settings of no-blinking-cursor are here.
    1080           0 :   (unless (or noninteractive
    1081           0 :               emacs-basic-display
    1082           0 :               (and (memq window-system '(x w32 ns))
    1083           0 :                    (not (member (x-get-resource "cursorBlink" "CursorBlink")
    1084           0 :                                 '("no" "off" "false" "0")))))
    1085           0 :     (setq no-blinking-cursor t))
    1086             : 
    1087           0 :   (unless noninteractive
    1088           0 :     (startup--setup-quote-display)
    1089           0 :     (setq internal--text-quoting-flag t))
    1090             : 
    1091             :   ;; Re-evaluate predefined variables whose initial value depends on
    1092             :   ;; the runtime context.
    1093           0 :   (mapc 'custom-reevaluate-setting
    1094             :         ;; Initialize them in the same order they were loaded, in case there
    1095             :         ;; are dependencies between them.
    1096           0 :         (prog1 (nreverse custom-delayed-init-variables)
    1097           0 :           (setq custom-delayed-init-variables nil)))
    1098             : 
    1099           0 :   (normal-erase-is-backspace-setup-frame)
    1100             : 
    1101             :   ;; Register default TTY colors for the case the terminal hasn't a
    1102             :   ;; terminal init file.  We do this regardless of whether the terminal
    1103             :   ;; supports colors or not and regardless the current display type,
    1104             :   ;; since users can connect to color-capable terminals and also
    1105             :   ;; switch color support on or off in mid-session by setting the
    1106             :   ;; tty-color-mode frame parameter.
    1107             :   ;; Exception: the `pc' ``window system'' has only 16 fixed colors,
    1108             :   ;; and they are already set at this point by a suitable method of
    1109             :   ;; window-system-initialization.
    1110           0 :   (or (eq initial-window-system 'pc)
    1111           0 :       (tty-register-default-colors))
    1112             : 
    1113           0 :   (let ((old-scalable-fonts-allowed scalable-fonts-allowed)
    1114           0 :         (old-face-ignored-fonts face-ignored-fonts))
    1115             : 
    1116             :     ;; Run the site-start library if it exists.  The point of this file is
    1117             :     ;; that it is run before .emacs.  There is no point in doing this after
    1118             :     ;; .emacs; that is useless.
    1119             :     ;; Note that user-init-file is nil at this point.  Code that might
    1120             :     ;; be loaded from site-run-file and wants to test if -q was given
    1121             :     ;; should check init-file-user instead, since that is already set.
    1122             :     ;; See cus-edit.el for an example.
    1123           0 :     (if site-run-file
    1124           0 :         (load site-run-file t t))
    1125             : 
    1126             :     ;; Sites should not disable this.  Only individuals should disable
    1127             :     ;; the startup screen.
    1128           0 :     (setq inhibit-startup-screen nil)
    1129             : 
    1130             :     ;; Warn for invalid user name.
    1131           0 :     (when init-file-user
    1132           0 :       (if (string-match "[~/:\n]" init-file-user)
    1133           0 :           (display-warning 'initialization
    1134           0 :                            (format "Invalid user name %s"
    1135           0 :                                    init-file-user)
    1136           0 :                            :error)
    1137           0 :         (if (file-directory-p (expand-file-name
    1138             :                                ;; We don't support ~USER on MS-Windows
    1139             :                                ;; and MS-DOS except for the current
    1140             :                                ;; user, and always load .emacs from
    1141             :                                ;; the current user's home directory
    1142             :                                ;; (see below).  So always check "~",
    1143             :                                ;; even if invoked with "-u USER", or
    1144             :                                ;; if $USER or $LOGNAME are set to
    1145             :                                ;; something different.
    1146           0 :                                (if (memq system-type '(windows-nt ms-dos))
    1147             :                                    "~"
    1148           0 :                                  (concat "~" init-file-user))))
    1149             :             nil
    1150           0 :           (display-warning 'initialization
    1151           0 :                            (format "User %s has no home directory"
    1152           0 :                                    (if (equal init-file-user "")
    1153           0 :                                        (user-real-login-name)
    1154           0 :                                      init-file-user))
    1155           0 :                            :error))))
    1156             : 
    1157             :     ;; Load that user's init file, or the default one, or none.
    1158           0 :     (let (debug-on-error-from-init-file
    1159             :           debug-on-error-should-be-set
    1160             :           (debug-on-error-initial
    1161           0 :            (if (eq init-file-debug t) 'startup init-file-debug))
    1162           0 :           (orig-enable-multibyte (default-value 'enable-multibyte-characters)))
    1163           0 :       (let ((debug-on-error debug-on-error-initial)
    1164             :             ;; This function actually reads the init files.
    1165             :             (inner
    1166           0 :              (function
    1167             :               (lambda ()
    1168           0 :                 (if init-file-user
    1169           0 :                     (let ((user-init-file-1
    1170           0 :                            (cond
    1171           0 :                              ((eq system-type 'ms-dos)
    1172           0 :                               (concat "~" init-file-user "/_emacs"))
    1173           0 :                              ((not (eq system-type 'windows-nt))
    1174           0 :                               (concat "~" init-file-user "/.emacs"))
    1175             :                              ;; Else deal with the Windows situation
    1176           0 :                              ((directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$")
    1177             :                               ;; Prefer .emacs on Windows.
    1178             :                               "~/.emacs")
    1179           0 :                              ((directory-files "~" nil "^_emacs\\(\\.elc?\\)?$")
    1180             :                               ;; Also support _emacs for compatibility, but warn about it.
    1181           0 :                               (push `(initialization
    1182           0 :                                       ,(format-message
    1183           0 :                                         "`_emacs' init file is deprecated, please use `.emacs'"))
    1184           0 :                                     delayed-warnings-list)
    1185             :                               "~/_emacs")
    1186             :                              (t ;; But default to .emacs if _emacs does not exist.
    1187           0 :                               "~/.emacs"))))
    1188             :                       ;; This tells `load' to store the file name found
    1189             :                       ;; into user-init-file.
    1190           0 :                       (setq user-init-file t)
    1191           0 :                       (load user-init-file-1 t t)
    1192             : 
    1193           0 :                       (when (eq user-init-file t)
    1194             :                         ;; If we did not find ~/.emacs, try
    1195             :                         ;; ~/.emacs.d/init.el.
    1196           0 :                         (let ((otherfile
    1197           0 :                                (expand-file-name
    1198             :                                 "init"
    1199           0 :                                 (file-name-as-directory
    1200           0 :                                  (concat "~" init-file-user "/.emacs.d")))))
    1201           0 :                           (load otherfile t t)
    1202             : 
    1203             :                           ;; If we did not find the user's init file,
    1204             :                           ;; set user-init-file conclusively.
    1205             :                           ;; Don't let it be set from default.el.
    1206           0 :                           (when (eq user-init-file t)
    1207           0 :                             (setq user-init-file user-init-file-1))))
    1208             : 
    1209             :                       ;; If we loaded a compiled file, set
    1210             :                       ;; `user-init-file' to the source version if that
    1211             :                       ;; exists.
    1212           0 :                       (when (and user-init-file
    1213           0 :                                  (equal (file-name-extension user-init-file)
    1214           0 :                                         "elc"))
    1215           0 :                         (let* ((source (file-name-sans-extension user-init-file))
    1216           0 :                                (alt (concat source ".el")))
    1217           0 :                           (setq source (cond ((file-exists-p alt) alt)
    1218           0 :                                              ((file-exists-p source) source)
    1219           0 :                                              (t nil)))
    1220           0 :                           (when source
    1221           0 :                             (when (file-newer-than-file-p source user-init-file)
    1222           0 :                               (message "Warning: %s is newer than %s"
    1223           0 :                                        source user-init-file)
    1224           0 :                               (sit-for 1))
    1225           0 :                             (setq user-init-file source))))
    1226             : 
    1227           0 :                       (unless inhibit-default-init
    1228           0 :                         (let ((inhibit-startup-screen nil))
    1229             :                           ;; Users are supposed to be told their rights.
    1230             :                           ;; (Plus how to get help and how to undo.)
    1231             :                           ;; Don't you dare turn this off for anyone
    1232             :                           ;; except yourself.
    1233           0 :                           (load "default" t t)))))))))
    1234           0 :         (if init-file-debug
    1235             :             ;; Do this without a condition-case if the user wants to debug.
    1236           0 :             (funcall inner)
    1237           0 :           (condition-case error
    1238           0 :               (progn
    1239           0 :                 (funcall inner)
    1240           0 :                 (setq init-file-had-error nil))
    1241             :             (error
    1242           0 :              (display-warning
    1243             :               'initialization
    1244           0 :               (format-message "\
    1245             : An error occurred while loading `%s':\n\n%s%s%s\n\n\
    1246             : To ensure normal operation, you should investigate and remove the
    1247             : cause of the error in your initialization file.  Start Emacs with
    1248             : the `--debug-init' option to view a complete error backtrace."
    1249           0 :                       user-init-file
    1250           0 :                       (get (car error) 'error-message)
    1251           0 :                       (if (cdr error) ": " "")
    1252           0 :                       (mapconcat (lambda (s) (prin1-to-string s t))
    1253           0 :                                  (cdr error) ", "))
    1254           0 :               :warning)
    1255           0 :              (setq init-file-had-error t))))
    1256             : 
    1257           0 :       (if (and deactivate-mark transient-mark-mode)
    1258           0 :             (with-current-buffer (window-buffer)
    1259           0 :               (deactivate-mark)))
    1260             : 
    1261             :         ;; If the user has a file of abbrevs, read it (unless -batch).
    1262           0 :         (when (and (not noninteractive)
    1263           0 :                    (file-exists-p abbrev-file-name)
    1264           0 :                    (file-readable-p abbrev-file-name))
    1265           0 :             (quietly-read-abbrev-file abbrev-file-name))
    1266             : 
    1267             :         ;; If the abbrevs came entirely from the init file or the
    1268             :         ;; abbrevs file, they do not need saving.
    1269           0 :         (setq abbrevs-changed nil)
    1270             : 
    1271             :         ;; If we can tell that the init file altered debug-on-error,
    1272             :         ;; arrange to preserve the value that it set up.
    1273           0 :         (or (eq debug-on-error debug-on-error-initial)
    1274           0 :             (setq debug-on-error-should-be-set t
    1275           0 :                   debug-on-error-from-init-file debug-on-error)))
    1276           0 :       (if debug-on-error-should-be-set
    1277           0 :           (setq debug-on-error debug-on-error-from-init-file))
    1278           0 :       (unless (or (default-value 'enable-multibyte-characters)
    1279           0 :                   (eq orig-enable-multibyte (default-value
    1280           0 :                                               'enable-multibyte-characters)))
    1281             :         ;; Init file changed to unibyte.  Reset existing multibyte
    1282             :         ;; buffers (probably *scratch*, *Messages*, *Minibuf-0*).
    1283             :         ;; Arguably this should only be done if they're free of
    1284             :         ;; multibyte characters.
    1285           0 :         (mapc (lambda (buffer)
    1286           0 :                 (with-current-buffer buffer
    1287           0 :                   (if enable-multibyte-characters
    1288           0 :                       (set-buffer-multibyte nil))))
    1289           0 :               (buffer-list))
    1290             :         ;; Also re-set the language environment in case it was
    1291             :         ;; originally done before unibyte was set and is sensitive to
    1292             :         ;; unibyte (display table, terminal coding system &c).
    1293           0 :         (set-language-environment current-language-environment)))
    1294             : 
    1295             :     ;; Do this here in case the init file sets mail-host-address.
    1296           0 :     (and mail-host-address
    1297             :          ;; Check that user-mail-address has not been set by hand.
    1298             :          ;; Yes, this is ugly, but slightly less so than leaving
    1299             :          ;; user-mail-address uninitialized during init file processing.
    1300             :          ;; Perhaps we should make :set-after do something like this?
    1301             :          ;; Ie, extend it to also mean (re)initialize-after.  See etc/TODO.
    1302           0 :          (equal user-mail-address
    1303           0 :                 (let (mail-host-address)
    1304           0 :                   (ignore-errors
    1305           0 :                     (eval (car (get 'user-mail-address 'standard-value))))))
    1306           0 :          (custom-reevaluate-setting 'user-mail-address))
    1307             : 
    1308             :     ;; If parameter have been changed in the init file which influence
    1309             :     ;; face realization, clear the face cache so that new faces will
    1310             :     ;; be realized.
    1311           0 :     (unless (and (eq scalable-fonts-allowed old-scalable-fonts-allowed)
    1312           0 :                  (eq face-ignored-fonts old-face-ignored-fonts))
    1313           0 :       (clear-face-cache)))
    1314             : 
    1315             :   ;; If any package directory exists, initialize the package system.
    1316           0 :   (and user-init-file
    1317           0 :        package-enable-at-startup
    1318           0 :        (catch 'package-dir-found
    1319           0 :          (let (dirs)
    1320           0 :            (if (boundp 'package-directory-list)
    1321           0 :                (setq dirs package-directory-list)
    1322           0 :              (dolist (f load-path)
    1323           0 :                (and (stringp f)
    1324           0 :                     (equal (file-name-nondirectory f) "site-lisp")
    1325           0 :                     (push (expand-file-name "elpa" f) dirs))))
    1326           0 :            (push (if (boundp 'package-user-dir)
    1327           0 :                      package-user-dir
    1328           0 :                    (locate-user-emacs-file "elpa"))
    1329           0 :                  dirs)
    1330           0 :            (dolist (dir dirs)
    1331           0 :              (when (file-directory-p dir)
    1332           0 :                (dolist (subdir (directory-files dir))
    1333           0 :                  (when (let ((subdir (expand-file-name subdir dir)))
    1334           0 :                          (and (file-directory-p subdir)
    1335           0 :                               (file-exists-p
    1336           0 :                                (expand-file-name
    1337           0 :                                 (package--description-file subdir)
    1338           0 :                                 subdir))))
    1339           0 :                    (throw 'package-dir-found t)))))))
    1340           0 :        (package-initialize))
    1341             : 
    1342           0 :   (setq after-init-time (current-time))
    1343             :   ;; Display any accumulated warnings after all functions in
    1344             :   ;; `after-init-hook' like `desktop-read' have finalized possible
    1345             :   ;; changes in the window configuration.
    1346           0 :   (run-hooks 'after-init-hook 'delayed-warnings-hook)
    1347             : 
    1348             :   ;; If *scratch* exists and init file didn't change its mode, initialize it.
    1349           0 :   (if (get-buffer "*scratch*")
    1350           0 :       (with-current-buffer "*scratch*"
    1351           0 :         (if (eq major-mode 'fundamental-mode)
    1352           0 :             (funcall initial-major-mode))))
    1353             : 
    1354             :   ;; Load library for our terminal type.
    1355             :   ;; User init file can set term-file-prefix to nil to prevent this.
    1356           0 :   (unless (or noninteractive
    1357           0 :               initial-window-system
    1358           0 :               (daemonp))
    1359           0 :     (tty-run-terminal-initialization (selected-frame) nil t))
    1360             : 
    1361             :   ;; Update the out-of-memory error message based on user's key bindings
    1362             :   ;; for save-some-buffers.
    1363           0 :   (setq memory-signal-data
    1364           0 :         (list 'error
    1365           0 :               (substitute-command-keys "Memory exhausted--use \\[save-some-buffers] then exit and restart Emacs")))
    1366             : 
    1367             :   ;; Process the remaining args.
    1368           0 :   (command-line-1 (cdr command-line-args))
    1369             : 
    1370             :   ;; This is a problem because, e.g. if emacs.d/gnus.el exists,
    1371             :   ;; trying to load gnus could load the wrong file.
    1372             :   ;; OK, it would not matter if .emacs.d were at the end of load-path.
    1373             :   ;; but for the sake of simplicity, we discourage it full-stop.
    1374             :   ;; Ref eg http://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00056.html
    1375             :   ;;
    1376             :   ;; A bad element could come from user-emacs-file, the command line,
    1377             :   ;; or EMACSLOADPATH, so we basically always have to check.
    1378           0 :   (let (warned)
    1379           0 :     (dolist (dir load-path)
    1380           0 :       (and (not warned)
    1381           0 :            (stringp dir)
    1382           0 :            (string-equal (file-name-as-directory (expand-file-name dir))
    1383           0 :                          (expand-file-name user-emacs-directory))
    1384           0 :            (setq warned t)
    1385           0 :            (display-warning 'initialization
    1386           0 :                             (format-message "\
    1387             : Your `load-path' seems to contain\n\
    1388             : your `.emacs.d' directory: %s\n\
    1389             : This is likely to cause problems...\n\
    1390             : Consider using a subdirectory instead, e.g.: %s"
    1391           0 :                                     dir (expand-file-name
    1392           0 :                                          "lisp" user-emacs-directory))
    1393           0 :                             :warning))))
    1394             : 
    1395             :   ;; If -batch, terminate after processing the command options.
    1396           0 :   (if noninteractive (kill-emacs t))
    1397             : 
    1398             :   ;; In daemon mode, start the server to allow clients to connect.
    1399             :   ;; This is done after loading the user's init file and after
    1400             :   ;; processing all command line arguments to allow e.g. `server-name'
    1401             :   ;; to be changed before the server starts.
    1402           0 :   (let ((dn (daemonp)))
    1403           0 :     (when dn
    1404           0 :       (when (stringp dn) (setq server-name dn))
    1405           0 :       (server-start)
    1406           0 :       (if server-process
    1407           0 :           (daemon-initialized)
    1408           0 :         (if (stringp dn)
    1409           0 :             (message
    1410             :              "Unable to start daemon: Emacs server named %S already running"
    1411           0 :              server-name)
    1412           0 :           (message "Unable to start the daemon.\nAnother instance of Emacs is running the server, either as daemon or interactively.\nYou can use emacsclient to connect to that Emacs process."))
    1413           0 :         (kill-emacs 1))))
    1414             : 
    1415             :   ;; Run emacs-session-restore (session management) if started by
    1416             :   ;; the session manager and we have a session manager connection.
    1417           0 :   (if (and (boundp 'x-session-previous-id)
    1418           0 :            (stringp x-session-previous-id))
    1419           0 :       (with-no-warnings
    1420           0 :         (emacs-session-restore x-session-previous-id))))
    1421             : 
    1422             : (defun x-apply-session-resources ()
    1423             :   "Apply X resources which specify initial values for Emacs variables.
    1424             : This is called from a window-system initialization function, such
    1425             : as `x-initialize-window-system' for X, either at startup (prior
    1426             : to reading the init file), or afterwards when the user first
    1427             : opens a graphical frame.
    1428             : 
    1429             : This can set the values of `menu-bar-mode', `tool-bar-mode', and
    1430             : `no-blinking-cursor', as well as the `cursor' face.  Changed
    1431             : settings will be marked as \"CHANGED outside of Customize\"."
    1432           0 :   (let ((no-vals  '("no" "off" "false" "0"))
    1433             :         (settings '(("menuBar" "MenuBar" menu-bar-mode nil)
    1434             :                     ("toolBar" "ToolBar" tool-bar-mode nil)
    1435             :                     ("scrollBar" "ScrollBar" scroll-bar-mode nil)
    1436             :                     ("cursorBlink" "CursorBlink" no-blinking-cursor t))))
    1437           0 :     (dolist (x settings)
    1438           0 :       (if (member (x-get-resource (nth 0 x) (nth 1 x)) no-vals)
    1439           0 :           (set (nth 2 x) (nth 3 x)))))
    1440           0 :   (let ((color (x-get-resource "cursorColor" "Foreground")))
    1441           0 :     (when color
    1442           0 :       (put 'cursor 'theme-face
    1443           0 :            `((changed ((t :background ,color)))))
    1444           0 :       (put 'cursor 'face-modified t))))
    1445             : 
    1446             : (defcustom initial-scratch-message (purecopy "\
    1447             : ;; This buffer is for text that is not saved, and for Lisp evaluation.
    1448             : ;; To create a file, visit it with \\[find-file] and enter text in its buffer.
    1449             : 
    1450             : ")
    1451             :   "Initial documentation displayed in *scratch* buffer at startup.
    1452             : If this is nil, no message will be displayed."
    1453             :   :type '(choice (text :tag "Message")
    1454             :                  (const :tag "none" nil))
    1455             :   :group 'initialization)
    1456             : 
    1457             : 
    1458             : ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    1459             : ;;; Fancy splash screen
    1460             : ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    1461             : 
    1462             : (defconst fancy-startup-text
    1463             :   `((:face (variable-pitch font-lock-comment-face)
    1464             :      "Welcome to "
    1465             :      :link ("GNU Emacs"
    1466             :             ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/"))
    1467             :             "Browse http://www.gnu.org/software/emacs/")
    1468             :      ", one component of the "
    1469             :      :link
    1470             :      ,(lambda ()
    1471             :        (if (eq system-type 'gnu/linux)
    1472             :             `("GNU/Linux"
    1473             :               ,(lambda (_button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
    1474             :              "Browse http://www.gnu.org/gnu/linux-and-gnu.html")
    1475             :           `("GNU" ,(lambda (_button)
    1476             :                      (browse-url "http://www.gnu.org/gnu/thegnuproject.html"))
    1477             :             "Browse http://www.gnu.org/gnu/thegnuproject.html")))
    1478             :      " operating system.\n\n"
    1479             :      :face variable-pitch
    1480             :      :link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial)))
    1481             :      "\tLearn basic keystroke commands"
    1482             :      ,(lambda ()
    1483             :        (let* ((en "TUTORIAL")
    1484             :               (tut (or (get-language-info current-language-environment
    1485             :                                           'tutorial)
    1486             :                        en))
    1487             :               (title (with-temp-buffer
    1488             :                        (insert-file-contents
    1489             :                         (expand-file-name tut tutorial-directory)
    1490             :                         ;; We used to read only the first 256 bytes of
    1491             :                         ;; the tutorial, but that prevents the coding:
    1492             :                         ;; setting, if any, in file-local variables
    1493             :                         ;; section to be seen by insert-file-contents,
    1494             :                         ;; and results in gibberish when the language
    1495             :                         ;; environment's preferred encoding is
    1496             :                         ;; different from what the file-local variable
    1497             :                         ;; says.  One case in point is Hebrew.
    1498             :                         nil)
    1499             :                        (search-forward ".")
    1500             :                        (buffer-substring (point-min) (1- (point))))))
    1501             :          ;; If there is a specific tutorial for the current language
    1502             :          ;; environment and it is not English, append its title.
    1503             :          (if (string= en tut)
    1504             :              ""
    1505             :            (concat " (" title ")"))))
    1506             :      "\n"
    1507             :      :link ("Emacs Guided Tour"
    1508             :             ,(lambda (_button)
    1509             :                (browse-url "http://www.gnu.org/software/emacs/tour/"))
    1510             :             "Browse http://www.gnu.org/software/emacs/tour/")
    1511             :      "\tOverview of Emacs features at gnu.org\n"
    1512             :      :link ("View Emacs Manual" ,(lambda (_button) (info-emacs-manual)))
    1513             :      "\tView the Emacs manual using Info\n"
    1514             :      :link ("Absence of Warranty" ,(lambda (_button) (describe-no-warranty)))
    1515             :      "\tGNU Emacs comes with "
    1516             :      :face (variable-pitch (:slant oblique))
    1517             :      "ABSOLUTELY NO WARRANTY\n"
    1518             :      :face variable-pitch
    1519             :      :link ("Copying Conditions" ,(lambda (_button) (describe-copying)))
    1520             :      "\tConditions for redistributing and changing Emacs\n"
    1521             :      :link ("Ordering Manuals" ,(lambda (_button) (view-order-manuals)))
    1522             :      "\tPurchasing printed copies of manuals\n"
    1523             :      "\n"))
    1524             :   "A list of texts to show in the middle part of splash screens.
    1525             : Each element in the list should be a list of strings or pairs
    1526             : `:face FACE', like `fancy-splash-insert' accepts them.")
    1527             : 
    1528             : (defconst fancy-about-text
    1529             :   `((:face (variable-pitch font-lock-comment-face)
    1530             :      "This is "
    1531             :      :link ("GNU Emacs"
    1532             :             ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/"))
    1533             :             "Browse http://www.gnu.org/software/emacs/")
    1534             :      ", one component of the "
    1535             :      :link
    1536             :      ,(lambda ()
    1537             :        (if (eq system-type 'gnu/linux)
    1538             :            `("GNU/Linux"
    1539             :              ,(lambda (_button)
    1540             :                 (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
    1541             :              "Browse http://www.gnu.org/gnu/linux-and-gnu.html")
    1542             :          `("GNU" ,(lambda (_button) (describe-gnu-project))
    1543             :            "Display info on the GNU project.")))
    1544             :      " operating system.\n"
    1545             :      :face (variable-pitch font-lock-builtin-face)
    1546             :      "\n"
    1547             :      ,(lambda () (emacs-version))
    1548             :      "\n"
    1549             :      :face (variable-pitch (:height 0.8))
    1550             :      ,(lambda () emacs-copyright)
    1551             :      "\n\n"
    1552             :      :face variable-pitch
    1553             :      :link ("Authors"
    1554             :             ,(lambda (_button)
    1555             :               (view-file (expand-file-name "AUTHORS" data-directory))
    1556             :               (goto-char (point-min))))
    1557             :      "\tMany people have contributed code included in GNU Emacs\n"
    1558             :      :link ("Contributing"
    1559             :             ,(lambda (_button) (info "(emacs)Contributing")))
    1560             :      "\tHow to contribute improvements to Emacs\n"
    1561             :      "\n"
    1562             :      :link ("GNU and Freedom" ,(lambda (_button) (describe-gnu-project)))
    1563             :      "\tWhy we developed GNU Emacs, and the GNU operating system\n"
    1564             :      :link ("Absence of Warranty" ,(lambda (_button) (describe-no-warranty)))
    1565             :      "\tGNU Emacs comes with "
    1566             :      :face (variable-pitch (:slant oblique))
    1567             :      "ABSOLUTELY NO WARRANTY\n"
    1568             :      :face variable-pitch
    1569             :      :link ("Copying Conditions" ,(lambda (_button) (describe-copying)))
    1570             :      "\tConditions for redistributing and changing Emacs\n"
    1571             :      :link ("Getting New Versions" ,(lambda (_button) (describe-distribution)))
    1572             :      "\tHow to obtain the latest version of Emacs\n"
    1573             :      :link ("Ordering Manuals" ,(lambda (_button) (view-order-manuals)))
    1574             :      "\tBuying printed manuals from the FSF\n"
    1575             :      "\n"
    1576             :      :link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial)))
    1577             :      "\tLearn basic Emacs keystroke commands"
    1578             :      ,(lambda ()
    1579             :        (let* ((en "TUTORIAL")
    1580             :               (tut (or (get-language-info current-language-environment
    1581             :                                           'tutorial)
    1582             :                        en))
    1583             :               (title (with-temp-buffer
    1584             :                        (insert-file-contents
    1585             :                         (expand-file-name tut tutorial-directory)
    1586             :                         ;; Read the entire file, to make sure any
    1587             :                         ;; coding cookies and other local variables
    1588             :                         ;; get acted upon.
    1589             :                         nil)
    1590             :                        (search-forward ".")
    1591             :                        (buffer-substring (point-min) (1- (point))))))
    1592             :          ;; If there is a specific tutorial for the current language
    1593             :          ;; environment and it is not English, append its title.
    1594             :          (if (string= en tut)
    1595             :              ""
    1596             :            (concat " (" title ")"))))
    1597             :      "\n"
    1598             :      :link ("Emacs Guided Tour"
    1599             :             ,(lambda (_button)
    1600             :                (browse-url "http://www.gnu.org/software/emacs/tour/"))
    1601             :             "Browse http://www.gnu.org/software/emacs/tour/")
    1602             :      "\tSee an overview of Emacs features at gnu.org"))
    1603             :   "A list of texts to show in the middle part of the About screen.
    1604             : Each element in the list should be a list of strings or pairs
    1605             : `:face FACE', like `fancy-splash-insert' accepts them.")
    1606             : 
    1607             : 
    1608             : (defgroup fancy-splash-screen ()
    1609             :   "Fancy splash screen when Emacs starts."
    1610             :   :version "21.1"
    1611             :   :group 'initialization)
    1612             : 
    1613             : (defcustom fancy-splash-image nil
    1614             :   "The image to show in the splash screens, or nil for defaults."
    1615             :   :group 'fancy-splash-screen
    1616             :   :type '(choice (const :tag "Default" nil)
    1617             :                  (file :tag "File")))
    1618             : 
    1619             : 
    1620             : (defvar splash-screen-keymap
    1621             :   (let ((map (make-sparse-keymap)))
    1622             :     (suppress-keymap map)
    1623             :     (set-keymap-parent map button-buffer-map)
    1624             :     (define-key map "\C-?" 'scroll-down-command)
    1625             :     (define-key map [?\S-\ ] 'scroll-down-command)
    1626             :     (define-key map " " 'scroll-up-command)
    1627             :     (define-key map "q" 'exit-splash-screen)
    1628             :     map)
    1629             :   "Keymap for splash screen buffer.")
    1630             : 
    1631             : ;; These are temporary storage areas for the splash screen display.
    1632             : 
    1633             : (defun fancy-splash-insert (&rest args)
    1634             :   "Insert text into the current buffer, with faces.
    1635             : Arguments from ARGS should be either strings; functions called
    1636             : with no args that return a string; pairs `:face FACE', where FACE
    1637             : is a face specification usable with `put-text-property'; or pairs
    1638             : `:link LINK' where LINK is a list of arguments to pass to
    1639             : `insert-button', of the form (LABEL ACTION [HELP-ECHO]), which
    1640             : specifies the button's label, `action' property and help-echo string.
    1641             : FACE and LINK can also be functions, which are evaluated to obtain
    1642             : a face or button specification."
    1643           0 :   (let ((current-face nil))
    1644           0 :     (while args
    1645           0 :       (cond ((eq (car args) :face)
    1646           0 :              (setq args (cdr args) current-face (car args))
    1647           0 :              (if (functionp current-face)
    1648           0 :                  (setq current-face (funcall current-face))))
    1649           0 :             ((eq (car args) :link)
    1650           0 :              (setq args (cdr args))
    1651           0 :              (let ((spec (car args)))
    1652           0 :                (if (functionp spec)
    1653           0 :                    (setq spec (funcall spec)))
    1654           0 :                (insert-button (car spec)
    1655           0 :                               'face (list 'link current-face)
    1656           0 :                               'action (cadr spec)
    1657           0 :                               'help-echo (concat "mouse-2, RET: "
    1658           0 :                                                  (or (nth 2 spec)
    1659           0 :                                                      "Follow this link"))
    1660           0 :                               'follow-link t)))
    1661           0 :             (t (insert (propertize (let ((it (car args)))
    1662           0 :                                      (if (functionp it)
    1663           0 :                                          (funcall it)
    1664           0 :                                        it))
    1665           0 :                                    'face current-face
    1666           0 :                                    'help-echo (startup-echo-area-message)))))
    1667           0 :       (setq args (cdr args)))))
    1668             : 
    1669             : (declare-function image-size "image.c" (spec &optional pixels frame))
    1670             : 
    1671             : (defun fancy-splash-image-file ()
    1672           0 :   (cond ((stringp fancy-splash-image) fancy-splash-image)
    1673           0 :         ((display-color-p)
    1674           0 :          (cond ((<= (display-planes) 8)
    1675           0 :                 (if (image-type-available-p 'xpm)
    1676             :                     "splash.xpm"
    1677           0 :                   "splash.pbm"))
    1678           0 :                ((or (image-type-available-p 'svg)
    1679           0 :                     (image-type-available-p 'imagemagick))
    1680             :                 "splash.svg")
    1681           0 :                ((image-type-available-p 'png)
    1682             :                 "splash.png")
    1683           0 :                ((image-type-available-p 'xpm)
    1684             :                 "splash.xpm")
    1685           0 :                (t "splash.pbm")))
    1686           0 :         (t "splash.pbm")))
    1687             : 
    1688             : (defun fancy-splash-head ()
    1689             :   "Insert the head part of the splash screen into the current buffer."
    1690           0 :   (let* ((image-file (fancy-splash-image-file))
    1691           0 :          (img (create-image image-file))
    1692           0 :          (image-width (and img (car (image-size img))))
    1693           0 :          (window-width (window-width)))
    1694           0 :     (when img
    1695           0 :       (when (> window-width image-width)
    1696             :         ;; Center the image in the window.
    1697           0 :         (insert (propertize " " 'display
    1698           0 :                             `(space :align-to (+ center (-0.5 . ,img)))))
    1699             : 
    1700             :         ;; Change the color of the XPM version of the splash image
    1701             :         ;; so that it is visible with a dark frame background.
    1702           0 :         (when (and (memq 'xpm img)
    1703           0 :                    (eq (frame-parameter nil 'background-mode) 'dark))
    1704           0 :           (setq img (append img '(:color-symbols (("#000000" . "gray30"))))))
    1705             : 
    1706             :         ;; Insert the image with a help-echo and a link.
    1707           0 :         (make-button (prog1 (point) (insert-image img)) (point)
    1708             :                      'face 'default
    1709             :                      'help-echo "mouse-2, RET: Browse http://www.gnu.org/"
    1710           0 :                      'action (lambda (_button) (browse-url "http://www.gnu.org/"))
    1711           0 :                      'follow-link t)
    1712           0 :         (insert "\n\n")))))
    1713             : 
    1714             : (defun fancy-startup-tail (&optional concise)
    1715             :   "Insert the tail part of the splash screen into the current buffer."
    1716           0 :   (unless concise
    1717           0 :     (fancy-splash-insert
    1718             :      :face 'variable-pitch
    1719             :      "\nTo start...     "
    1720           0 :      :link `("Open a File"
    1721           0 :              ,(lambda (_button) (call-interactively 'find-file))
    1722           0 :              "Specify a new file's name, to edit the file")
    1723             :      "     "
    1724           0 :      :link `("Open Home Directory"
    1725           0 :              ,(lambda (_button) (dired "~"))
    1726           0 :              "Open your home directory, to operate on its files")
    1727             :      "     "
    1728           0 :      :link `("Customize Startup"
    1729           0 :              ,(lambda (_button) (customize-group 'initialization))
    1730           0 :              "Change initialization settings including this screen")
    1731           0 :      "\n"))
    1732           0 :   (fancy-splash-insert
    1733             :    :face 'variable-pitch "To quit a partially entered command, type "
    1734             :    :face 'default "Control-g"
    1735           0 :    :face 'variable-pitch ".\n")
    1736           0 :   (fancy-splash-insert :face `(variable-pitch font-lock-builtin-face)
    1737             :                        "\nThis is "
    1738           0 :                        (emacs-version)
    1739             :                        "\n"
    1740             :                        :face '(variable-pitch (:height 0.8))
    1741           0 :                        emacs-copyright
    1742           0 :                        "\n")
    1743           0 :   (when auto-save-list-file-prefix
    1744           0 :     (let ((dir  (file-name-directory auto-save-list-file-prefix))
    1745           0 :           (name (file-name-nondirectory auto-save-list-file-prefix))
    1746             :           files)
    1747             :       ;; Don't warn if the directory for auto-save-list files does not
    1748             :       ;; yet exist.
    1749           0 :       (and (file-directory-p dir)
    1750           0 :            (setq files (directory-files dir nil (concat "\\`" name) t))
    1751           0 :            (fancy-splash-insert :face '(variable-pitch font-lock-comment-face)
    1752           0 :                                 (if (= (length files) 1)
    1753             :                                     "\nAn auto-save file list was found.  "
    1754           0 :                                   "\nAuto-save file lists were found.  ")
    1755             :                                 "If an Emacs session crashed recently,\ntype "
    1756           0 :                                 :link `("M-x recover-session RET"
    1757             :                                         ,(lambda (_button)
    1758           0 :                                            (call-interactively
    1759           0 :                                             'recover-session)))
    1760           0 :                                 " to recover the files you were editing."))))
    1761             : 
    1762           0 :   (when concise
    1763           0 :     (fancy-splash-insert
    1764             :      :face 'variable-pitch "\n"
    1765           0 :      :link `("Dismiss this startup screen"
    1766             :              ,(lambda (_button)
    1767           0 :                 (when startup-screen-inhibit-startup-screen
    1768           0 :                   (customize-set-variable 'inhibit-startup-screen t)
    1769           0 :                   (customize-mark-to-save 'inhibit-startup-screen)
    1770           0 :                   (custom-save-all))
    1771           0 :                 (let ((w (get-buffer-window "*GNU Emacs*")))
    1772           0 :                   (and w (not (one-window-p)) (delete-window w)))
    1773           0 :                 (kill-buffer "*GNU Emacs*")))
    1774           0 :      "  ")
    1775           0 :     (when (or user-init-file custom-file)
    1776           0 :       (let ((checked (create-image "checked.xpm"
    1777           0 :                                    nil nil :ascent 'center))
    1778           0 :             (unchecked (create-image "unchecked.xpm"
    1779           0 :                                      nil nil :ascent 'center)))
    1780           0 :         (insert-button
    1781             :          " "
    1782           0 :          :on-glyph checked
    1783           0 :          :off-glyph unchecked
    1784           0 :          'checked nil 'display unchecked 'follow-link t
    1785             :          'action (lambda (button)
    1786           0 :                    (if (overlay-get button 'checked)
    1787           0 :                        (progn (overlay-put button 'checked nil)
    1788           0 :                               (overlay-put button 'display
    1789           0 :                                            (overlay-get button :off-glyph))
    1790           0 :                               (setq startup-screen-inhibit-startup-screen
    1791           0 :                                     nil))
    1792           0 :                      (overlay-put button 'checked t)
    1793           0 :                      (overlay-put button 'display
    1794           0 :                                   (overlay-get button :on-glyph))
    1795           0 :                      (setq startup-screen-inhibit-startup-screen t)))))
    1796           0 :       (fancy-splash-insert :face '(variable-pitch (:height 0.9))
    1797           0 :                            " Never show it again."))))
    1798             : 
    1799             : (defun exit-splash-screen ()
    1800             :   "Stop displaying the splash screen buffer."
    1801             :   (interactive)
    1802           0 :   (quit-window t))
    1803             : 
    1804             : (defun fancy-startup-screen (&optional concise)
    1805             :   "Display fancy startup screen.
    1806             : If CONCISE is non-nil, display a concise version of the
    1807             : splash screen in another window."
    1808           0 :   (let ((splash-buffer (get-buffer-create "*GNU Emacs*")))
    1809           0 :     (with-current-buffer splash-buffer
    1810           0 :       (let ((inhibit-read-only t))
    1811           0 :         (erase-buffer)
    1812           0 :         (setq default-directory command-line-default-directory)
    1813           0 :         (make-local-variable 'startup-screen-inhibit-startup-screen)
    1814           0 :         (if pure-space-overflow
    1815           0 :             (insert pure-space-overflow-message))
    1816           0 :         (unless concise
    1817           0 :           (fancy-splash-head))
    1818           0 :         (dolist (text fancy-startup-text)
    1819           0 :           (apply #'fancy-splash-insert text)
    1820           0 :           (insert "\n"))
    1821           0 :         (skip-chars-backward "\n")
    1822           0 :         (delete-region (point) (point-max))
    1823           0 :         (insert "\n")
    1824           0 :         (fancy-startup-tail concise))
    1825           0 :       (use-local-map splash-screen-keymap)
    1826           0 :       (setq-local browse-url-browser-function 'eww-browse-url)
    1827           0 :       (setq tab-width 22
    1828           0 :             buffer-read-only t)
    1829           0 :       (set-buffer-modified-p nil)
    1830           0 :       (if (and view-read-only (not view-mode))
    1831           0 :           (view-mode-enter nil 'kill-buffer))
    1832           0 :       (goto-char (point-min))
    1833           0 :       (forward-line (if concise 2 4)))
    1834           0 :     (if concise
    1835           0 :         (progn
    1836           0 :           (display-buffer splash-buffer)
    1837             :           ;; If the splash screen is in a split window, fit it.
    1838           0 :           (let ((window (get-buffer-window splash-buffer t)))
    1839           0 :             (or (null window)
    1840           0 :                 (eq window (selected-window))
    1841           0 :                 (eq window (next-window window))
    1842           0 :                 (fit-window-to-buffer window))))
    1843           0 :       (switch-to-buffer splash-buffer))))
    1844             : 
    1845             : (defun fancy-about-screen ()
    1846             :   "Display fancy About screen."
    1847           0 :   (let ((frame (fancy-splash-frame)))
    1848           0 :     (save-selected-window
    1849           0 :       (select-frame frame)
    1850           0 :       (switch-to-buffer "*About GNU Emacs*")
    1851           0 :       (setq buffer-undo-list t)
    1852           0 :       (let ((inhibit-read-only t))
    1853           0 :         (erase-buffer)
    1854           0 :         (if pure-space-overflow
    1855           0 :             (insert pure-space-overflow-message))
    1856           0 :         (fancy-splash-head)
    1857           0 :         (dolist (text fancy-about-text)
    1858           0 :           (apply #'fancy-splash-insert text)
    1859           0 :           (insert "\n"))
    1860           0 :         (set-buffer-modified-p nil)
    1861           0 :         (goto-char (point-min))
    1862           0 :         (force-mode-line-update))
    1863           0 :       (use-local-map splash-screen-keymap)
    1864           0 :       (setq-local browse-url-browser-function 'eww-browse-url)
    1865           0 :       (setq tab-width 22)
    1866           0 :       (setq buffer-read-only t)
    1867           0 :       (goto-char (point-min))
    1868           0 :       (forward-line 3))))
    1869             : 
    1870             : (defun fancy-splash-frame ()
    1871             :   "Return the frame to use for the fancy splash screen.
    1872             : Returning non-nil does not mean we should necessarily
    1873             : use the fancy splash screen, but if we do use it,
    1874             : we put it on this frame."
    1875           0 :   (let (chosen-frame)
    1876             :     ;; MS-Windows needs this to have a chance to make the initial
    1877             :     ;; frame visible.
    1878           0 :     (if (eq (window-system) 'w32)
    1879           0 :         (sit-for 0 t))
    1880           0 :     (dolist (frame (append (frame-list) (list (selected-frame))))
    1881           0 :       (if (and (frame-visible-p frame)
    1882           0 :                (not (window-minibuffer-p (frame-selected-window frame))))
    1883           0 :           (setq chosen-frame frame)))
    1884           0 :     chosen-frame))
    1885             : 
    1886             : (defun use-fancy-splash-screens-p ()
    1887             :   "Return t if fancy splash screens should be used."
    1888           0 :   (when (and (display-graphic-p)
    1889           0 :              (or (and (display-color-p)
    1890           0 :                       (image-type-available-p 'xpm))
    1891           0 :                  (image-type-available-p 'pbm)))
    1892           0 :     (let ((frame (fancy-splash-frame)))
    1893           0 :       (when frame
    1894           0 :         (let* ((img (create-image (fancy-splash-image-file)))
    1895           0 :                (image-height (and img (cdr (image-size img nil frame))))
    1896             :                ;; We test frame-height and not window-height so that,
    1897             :                ;; if the frame is split by displaying a warning, that
    1898             :                ;; doesn't cause the normal splash screen to be used.
    1899             :                ;; We subtract 2 from frame-height to account for the
    1900             :                ;; echo area and the mode line.
    1901           0 :                (frame-height (- (frame-height frame) 2)))
    1902           0 :           (> frame-height (+ image-height 19)))))))
    1903             : 
    1904             : 
    1905             : (defun normal-splash-screen (&optional startup concise)
    1906             :   "Display non-graphic splash screen.
    1907             : If optional argument STARTUP is non-nil, display the startup screen
    1908             : after Emacs starts.  If STARTUP is nil, display the About screen.
    1909             : If CONCISE is non-nil, display a concise version of the
    1910             : splash screen in another window."
    1911           0 :   (let ((splash-buffer (get-buffer-create "*About GNU Emacs*")))
    1912           0 :     (with-current-buffer splash-buffer
    1913           0 :       (setq buffer-read-only nil)
    1914           0 :       (erase-buffer)
    1915           0 :       (setq default-directory command-line-default-directory)
    1916           0 :       (set (make-local-variable 'tab-width) 8)
    1917             : 
    1918           0 :       (if pure-space-overflow
    1919           0 :           (insert pure-space-overflow-message))
    1920             : 
    1921             :       ;; The convention for this piece of code is that
    1922             :       ;; each piece of output starts with one or two newlines
    1923             :       ;; and does not end with any newlines.
    1924           0 :       (insert (if startup "Welcome to GNU Emacs" "This is GNU Emacs"))
    1925           0 :       (insert
    1926           0 :        (if (eq system-type 'gnu/linux)
    1927             :            ", one component of the GNU/Linux operating system.\n"
    1928           0 :          ", a part of the GNU operating system.\n"))
    1929             : 
    1930           0 :       (if startup
    1931           0 :           (if (display-mouse-p)
    1932             :               ;; The user can use the mouse to activate menus
    1933             :               ;; so give help in terms of menu items.
    1934           0 :               (normal-mouse-startup-screen)
    1935             : 
    1936             :             ;; No mouse menus, so give help using kbd commands.
    1937           0 :             (normal-no-mouse-startup-screen))
    1938             : 
    1939           0 :         (normal-about-screen))
    1940             : 
    1941             :       ;; The rest of the startup screen is the same on all
    1942             :       ;; kinds of terminals.
    1943             : 
    1944             :       ;; Give information on recovering, if there was a crash.
    1945           0 :       (and startup
    1946           0 :            auto-save-list-file-prefix
    1947             :            ;; Don't signal an error if the
    1948             :            ;; directory for auto-save-list files
    1949             :            ;; does not yet exist.
    1950           0 :            (file-directory-p (file-name-directory
    1951           0 :                               auto-save-list-file-prefix))
    1952           0 :            (directory-files
    1953           0 :             (file-name-directory auto-save-list-file-prefix)
    1954             :             nil
    1955           0 :             (concat "\\`"
    1956           0 :                     (regexp-quote (file-name-nondirectory
    1957           0 :                                    auto-save-list-file-prefix)))
    1958           0 :             t)
    1959           0 :            (insert "\n\nIf an Emacs session crashed recently, "
    1960             :                    "type M-x recover-session RET\nto recover"
    1961           0 :                    " the files you were editing.\n"))
    1962             : 
    1963           0 :       (use-local-map splash-screen-keymap)
    1964             : 
    1965             :       ;; Display the input that we set up in the buffer.
    1966           0 :       (set-buffer-modified-p nil)
    1967           0 :       (setq buffer-read-only t)
    1968           0 :       (if (and view-read-only (not view-mode))
    1969           0 :           (view-mode-enter nil 'kill-buffer))
    1970           0 :       (if startup (rename-buffer "*GNU Emacs*" t))
    1971           0 :       (goto-char (point-min)))
    1972           0 :     (if concise
    1973           0 :         (display-buffer splash-buffer)
    1974           0 :       (switch-to-buffer splash-buffer))))
    1975             : 
    1976             : (defun normal-mouse-startup-screen ()
    1977             :   ;; The user can use the mouse to activate menus
    1978             :   ;; so give help in terms of menu items.
    1979           0 :   (insert "\
    1980             : To follow a link, click Mouse-1 on it, or move to it and type RET.
    1981           0 : To quit a partially entered command, type Control-g.\n")
    1982             : 
    1983           0 :   (insert "\nImportant Help menu items:\n")
    1984           0 :   (insert-button "Emacs Tutorial"
    1985           0 :                  'action (lambda (_button) (help-with-tutorial))
    1986           0 :                  'follow-link t)
    1987           0 :   (insert "\t\tLearn basic Emacs keystroke commands\n")
    1988           0 :   (insert-button "Read the Emacs Manual"
    1989           0 :                  'action (lambda (_button) (info-emacs-manual))
    1990           0 :                  'follow-link t)
    1991           0 :   (insert "\tView the Emacs manual using Info\n")
    1992           0 :   (insert-button "(Non)Warranty"
    1993           0 :                  'action (lambda (_button) (describe-no-warranty))
    1994           0 :                  'follow-link t)
    1995           0 :   (insert "\t\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n")
    1996           0 :   (insert-button "Copying Conditions"
    1997           0 :                  'action (lambda (_button) (describe-copying))
    1998           0 :                  'follow-link t)
    1999           0 :   (insert "\tConditions for redistributing and changing Emacs\n")
    2000           0 :   (insert-button "More Manuals / Ordering Manuals"
    2001           0 :                  'action (lambda (_button) (view-order-manuals))
    2002           0 :                  'follow-link t)
    2003           0 :   (insert "  How to order printed manuals from the FSF\n")
    2004             : 
    2005           0 :   (insert "\nUseful tasks:\n")
    2006           0 :   (insert-button "Visit New File"
    2007           0 :                  'action (lambda (_button) (call-interactively 'find-file))
    2008           0 :                  'follow-link t)
    2009           0 :   (insert (substitute-command-keys
    2010           0 :            "\t\tSpecify a new file's name, to edit the file\n"))
    2011           0 :   (insert-button "Open Home Directory"
    2012           0 :                  'action (lambda (_button) (dired "~"))
    2013           0 :                  'follow-link t)
    2014           0 :   (insert "\tOpen your home directory, to operate on its files\n")
    2015           0 :   (insert-button "Customize Startup"
    2016           0 :                  'action (lambda (_button) (customize-group 'initialization))
    2017           0 :                  'follow-link t)
    2018           0 :   (insert "\tChange initialization settings including this screen\n")
    2019             : 
    2020           0 :   (insert "\n" (emacs-version)
    2021           0 :           "\n" emacs-copyright))
    2022             : 
    2023             : (defun normal-no-mouse-startup-screen ()
    2024             :   "Show a splash screen suitable for displays without mouse support."
    2025           0 :   (let* ((c-h-accessible
    2026             :           ;; If normal-erase-is-backspace is used on a tty, there's
    2027             :           ;; no way to invoke C-h and you have to use F1 instead.
    2028           0 :           (or (not (char-table-p keyboard-translate-table))
    2029           0 :               (eq (aref keyboard-translate-table ?\C-h) ?\C-h)))
    2030             :          (minor-mode-overriding-map-alist
    2031           0 :           (cons (cons (not c-h-accessible)
    2032             :                       ;; If C-h can't be invoked, temporarily disable its
    2033             :                       ;; binding, so where-is uses alternative bindings.
    2034           0 :                       (let ((map (make-sparse-keymap)))
    2035           0 :                         (define-key map [?\C-h] 'undefined)
    2036           0 :                         map))
    2037           0 :                 minor-mode-overriding-map-alist)))
    2038             : 
    2039           0 :     (insert (format "\nGet help\t   %s\n"
    2040           0 :                     (let ((where (where-is-internal 'help-command nil t)))
    2041           0 :                       (cond
    2042           0 :                        ((equal where [?\C-h])
    2043             :                         "C-h  (Hold down CTRL and press h)")
    2044           0 :                        (where (key-description where))
    2045           0 :                        (t "M-x help")))))
    2046           0 :     (insert-button "Emacs manual"
    2047           0 :                    'action (lambda (_button) (info-emacs-manual))
    2048           0 :                    'follow-link t)
    2049           0 :     (insert (substitute-command-keys"\t   \\[info-emacs-manual]\t"))
    2050           0 :     (insert-button "Browse manuals"
    2051           0 :                    'action (lambda (_button) (Info-directory))
    2052           0 :                    'follow-link t)
    2053           0 :     (insert (substitute-command-keys "\t   \\[info]\n"))
    2054           0 :     (insert-button "Emacs tutorial"
    2055           0 :                    'action (lambda (_button) (help-with-tutorial))
    2056           0 :                    'follow-link t)
    2057           0 :     (insert (substitute-command-keys
    2058           0 :              "\t   \\[help-with-tutorial]\tUndo changes\t   \\[undo]\n"))
    2059           0 :     (insert-button "Buy manuals"
    2060           0 :                    'action (lambda (_button) (view-order-manuals))
    2061           0 :                    'follow-link t)
    2062           0 :     (insert (substitute-command-keys
    2063           0 :              "\t   \\[view-order-manuals]\tExit Emacs\t   \\[save-buffers-kill-terminal]")))
    2064             : 
    2065             :   ;; Say how to use the menu bar with the keyboard.
    2066           0 :   (insert "\n")
    2067           0 :   (insert-button "Activate menubar"
    2068           0 :                  'action (lambda (_button) (tmm-menubar))
    2069           0 :                  'follow-link t)
    2070           0 :   (if (and (eq (key-binding "\M-`") 'tmm-menubar)
    2071           0 :            (eq (key-binding [f10]) 'tmm-menubar))
    2072           0 :       (insert "   F10  or  ESC `  or   M-`")
    2073           0 :     (insert (substitute-command-keys "   \\[tmm-menubar]")))
    2074             : 
    2075             :   ;; Many users seem to have problems with these.
    2076           0 :   (insert (substitute-command-keys "
    2077             : \(`C-' means use the CTRL key.  `M-' means use the Meta (or Alt) key.
    2078           0 : If you have no Meta key, you may instead type ESC followed by the character.)"))
    2079             : 
    2080             :   ;; Insert links to useful tasks
    2081           0 :   (insert "\nUseful tasks:\n")
    2082             : 
    2083           0 :   (insert-button "Visit New File"
    2084           0 :                  'action (lambda (_button) (call-interactively 'find-file))
    2085           0 :                  'follow-link t)
    2086           0 :   (insert "\t\t\t")
    2087           0 :   (insert-button "Open Home Directory"
    2088           0 :                  'action (lambda (_button) (dired "~"))
    2089           0 :                  'follow-link t)
    2090           0 :   (insert "\n")
    2091             : 
    2092           0 :   (insert-button "Customize Startup"
    2093           0 :                  'action (lambda (_button) (customize-group 'initialization))
    2094           0 :                  'follow-link t)
    2095           0 :   (insert "\t\t")
    2096           0 :   (insert-button "Open *scratch* buffer"
    2097           0 :                  'action (lambda (_button) (switch-to-buffer
    2098           0 :                                        (get-buffer-create "*scratch*")))
    2099           0 :                  'follow-link t)
    2100           0 :   (insert "\n")
    2101           0 :   (insert "\n" (emacs-version) "\n" emacs-copyright "\n")
    2102           0 :   (insert (substitute-command-keys
    2103             :            "
    2104           0 : GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for "))
    2105           0 :   (insert-button "full details"
    2106           0 :                  'action (lambda (_button) (describe-no-warranty))
    2107           0 :                  'follow-link t)
    2108           0 :   (insert (substitute-command-keys ".
    2109             : Emacs is Free Software--Free as in Freedom--so you can redistribute copies
    2110           0 : of Emacs and modify it; type \\[describe-copying] to see "))
    2111           0 :   (insert-button "the conditions"
    2112           0 :                  'action (lambda (_button) (describe-copying))
    2113           0 :                  'follow-link t)
    2114           0 :   (insert (substitute-command-keys".
    2115           0 : Type \\[describe-distribution] for information on "))
    2116           0 :   (insert-button "getting the latest version"
    2117           0 :                  'action (lambda (_button) (describe-distribution))
    2118           0 :                  'follow-link t)
    2119           0 :   (insert "."))
    2120             : 
    2121             : (defun normal-about-screen ()
    2122           0 :   (insert "\n" (emacs-version) "\n" emacs-copyright "\n\n")
    2123             : 
    2124           0 :   (insert "To follow a link, click Mouse-1 on it, or move to it and type RET.\n\n")
    2125             : 
    2126           0 :   (insert-button "Authors"
    2127             :                  'action
    2128             :                  (lambda (_button)
    2129           0 :                    (view-file (expand-file-name "AUTHORS" data-directory))
    2130           0 :                    (goto-char (point-min)))
    2131           0 :                  'follow-link t)
    2132           0 :   (insert "\t\tMany people have contributed code included in GNU Emacs\n")
    2133             : 
    2134           0 :   (insert-button "Contributing"
    2135             :                  'action
    2136           0 :                  (lambda (_button) (info "(emacs)Contributing"))
    2137           0 :                  'follow-link t)
    2138           0 :   (insert "\tHow to contribute improvements to Emacs\n\n")
    2139             : 
    2140           0 :   (insert-button "GNU and Freedom"
    2141           0 :                  'action (lambda (_button) (describe-gnu-project))
    2142           0 :                  'follow-link t)
    2143           0 :   (insert "\t\tWhy we developed GNU Emacs and the GNU system\n")
    2144             : 
    2145           0 :   (insert-button "Absence of Warranty"
    2146           0 :                  'action (lambda (_button) (describe-no-warranty))
    2147           0 :                  'follow-link t)
    2148           0 :   (insert "\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n")
    2149             : 
    2150           0 :   (insert-button "Copying Conditions"
    2151           0 :                  'action (lambda (_button) (describe-copying))
    2152           0 :                  'follow-link t)
    2153           0 :   (insert "\tConditions for redistributing and changing Emacs\n")
    2154             : 
    2155           0 :   (insert-button "Getting New Versions"
    2156           0 :                  'action (lambda (_button) (describe-distribution))
    2157           0 :                  'follow-link t)
    2158           0 :   (insert "\tHow to get the latest version of GNU Emacs\n")
    2159             : 
    2160           0 :   (insert-button "More Manuals / Ordering Manuals"
    2161           0 :                  'action (lambda (_button) (view-order-manuals))
    2162           0 :                  'follow-link t)
    2163           0 :   (insert "\tBuying printed manuals from the FSF\n"))
    2164             : 
    2165             : (defun startup-echo-area-message ()
    2166           0 :   (if (daemonp)
    2167             :       "Starting Emacs daemon."
    2168           0 :     (substitute-command-keys
    2169             :      "For information about GNU Emacs and the GNU system, type \
    2170           0 : \\[about-emacs].")))
    2171             : 
    2172             : (defun display-startup-echo-area-message ()
    2173           0 :   (let ((resize-mini-windows t))
    2174           0 :     (or noninteractive                  ;(input-pending-p) init-file-had-error
    2175             :         ;; t if the init file says to inhibit the echo area startup message.
    2176           0 :         (and inhibit-startup-echo-area-message
    2177           0 :              user-init-file
    2178           0 :              (or (and (get 'inhibit-startup-echo-area-message 'saved-value)
    2179           0 :                       (equal inhibit-startup-echo-area-message
    2180           0 :                              (if (equal init-file-user "")
    2181           0 :                                  (user-login-name)
    2182           0 :                                init-file-user)))
    2183             :                  ;; Wasn't set with custom; see if .emacs has a setq.
    2184           0 :                  (condition-case nil
    2185           0 :                      (with-temp-buffer
    2186           0 :                        (insert-file-contents user-init-file)
    2187           0 :                        (re-search-forward
    2188           0 :                         (concat
    2189             :                          "([ \t\n]*setq[ \t\n]+"
    2190             :                          "inhibit-startup-echo-area-message[ \t\n]+"
    2191           0 :                          (regexp-quote
    2192           0 :                           (prin1-to-string
    2193           0 :                            (if (equal init-file-user "")
    2194           0 :                                (user-login-name)
    2195           0 :                              init-file-user)))
    2196           0 :                          "[ \t\n]*)")
    2197           0 :                         nil t))
    2198           0 :                    (error nil))))
    2199           0 :         (message "%s" (startup-echo-area-message)))))
    2200             : 
    2201             : (defun display-startup-screen (&optional concise)
    2202             :   "Display startup screen according to display.
    2203             : A fancy display is used on graphic displays, normal otherwise.
    2204             : 
    2205             : If CONCISE is non-nil, display a concise version of the startup
    2206             : screen."
    2207             :   ;; Prevent recursive calls from server-process-filter.
    2208           0 :   (if (not (get-buffer "*GNU Emacs*"))
    2209           0 :       (if (use-fancy-splash-screens-p)
    2210           0 :           (fancy-startup-screen concise)
    2211           0 :         (normal-splash-screen t concise))))
    2212             : 
    2213             : (defun display-about-screen ()
    2214             :   "Display the *About GNU Emacs* buffer.
    2215             : A fancy display is used on graphic displays, normal otherwise."
    2216             :   (interactive)
    2217           0 :   (if (use-fancy-splash-screens-p)
    2218           0 :       (fancy-about-screen)
    2219           0 :     (normal-splash-screen nil)))
    2220             : 
    2221             : (defalias 'about-emacs 'display-about-screen)
    2222             : (defalias 'display-splash-screen 'display-startup-screen)
    2223             : 
    2224             : (defun command-line-1 (args-left)
    2225             :   "A subroutine of `command-line'."
    2226           0 :   (display-startup-echo-area-message)
    2227           0 :   (when (and pure-space-overflow
    2228           0 :              (not noninteractive))
    2229           0 :     (display-warning
    2230             :      'initialization
    2231             :      "Building Emacs overflowed pure space.\
    2232             :   (See the node Pure Storage in the Lisp manual for details.)"
    2233           0 :      :warning))
    2234             : 
    2235             :   ;; `displayable-buffers' is a list of buffers that may be displayed,
    2236             :   ;; which includes files parsed from the command line arguments and
    2237             :   ;; `initial-buffer-choice'.  All of the display logic happens at the
    2238             :   ;; end of this `let'.  As files as processed from the command line
    2239             :   ;; arguments, their buffers are prepended to `displayable-buffers'.
    2240             :   ;; In order for options like "--eval" to work with the "--file" arg,
    2241             :   ;; the file buffers are set as the current buffer as they are seen
    2242             :   ;; on the command line (so "emacs --batch --file a --file b
    2243             :   ;; --eval='(message "%s" (buffer-name))'" will print "b"), but this
    2244             :   ;; does not affect the final displayed state of the buffers.
    2245           0 :   (let ((displayable-buffers nil))
    2246             :     ;; This `let' processes the command line arguments.
    2247           0 :     (let ((command-line-args-left args-left))
    2248           0 :       (when command-line-args-left
    2249             :         ;; We have command args; process them.
    2250           0 :         (let* ((dir command-line-default-directory)
    2251             :                tem
    2252             :                ;; This approach loses for "-batch -L DIR --eval "(require foo)",
    2253             :                ;; if foo is intended to be found in DIR.
    2254             :                ;;
    2255             :                ;; The directories listed in --directory/-L options will *appear*
    2256             :                ;; at the front of `load-path' in the order they appear on the
    2257             :                ;; command-line.  We cannot do this by *placing* them at the front
    2258             :                ;; in the order they appear, so we need this variable to hold them,
    2259             :                ;; temporarily.
    2260             :                ;;
    2261             :                ;; To DTRT we keep track of the splice point and modify `load-path'
    2262             :                ;; straight away upon any --directory/-L option.
    2263             :                splice
    2264             :                just-files ;; t if this follows the magic -- option.
    2265             :                ;; This includes our standard options' long versions
    2266             :                ;; and long versions of what's on command-switch-alist.
    2267             :                (longopts
    2268           0 :                 (append '("--funcall" "--load" "--insert" "--kill"
    2269             :                           "--directory" "--eval" "--execute" "--no-splash"
    2270             :                           "--find-file" "--visit" "--file" "--no-desktop")
    2271           0 :                         (mapcar (lambda (elt) (concat "-" (car elt)))
    2272           0 :                                 command-switch-alist)))
    2273             :                (line 0)
    2274             :                (column 0)
    2275             :                ;; `process-file-arg' opens a file buffer for `name',
    2276             :                ;; sets that buffer as the current buffer without
    2277             :                ;; displaying it, adds the buffer to
    2278             :                ;; `displayable-buffers', and puts the point at
    2279             :                ;; `line':`column'.  `line' and `column' are both reset
    2280             :                ;; to zero when `process-file-arg' returns.
    2281             :                (process-file-arg
    2282             :                 (lambda (name)
    2283             :                   ;; This can only happen if PWD is deleted.
    2284           0 :                   (if (not (or dir (file-name-absolute-p name)))
    2285           0 :                       (message "Ignoring relative file name (%s) due to \
    2286           0 : nil default-directory" name)
    2287           0 :                     (let* ((file (expand-file-name
    2288           0 :                                   (command-line-normalize-file-name name)
    2289           0 :                                   dir))
    2290           0 :                            (buf (find-file-noselect file)))
    2291           0 :                       (setq displayable-buffers (cons buf displayable-buffers))
    2292             :                       ;; Set the file buffer to the current buffer so
    2293             :                       ;; that it will be used with "--eval" and
    2294             :                       ;; similar options.
    2295           0 :                       (set-buffer buf)
    2296             :                       ;; Put the point at `line':`column' in the file
    2297             :                       ;; buffer, and reset `line' and `column' to 0.
    2298           0 :                       (unless (zerop line)
    2299           0 :                         (goto-char (point-min))
    2300           0 :                         (forward-line (1- line)))
    2301           0 :                       (setq line 0)
    2302           0 :                       (unless (< column 1)
    2303           0 :                         (move-to-column (1- column)))
    2304           0 :                       (setq column 0))))))
    2305             : 
    2306             :           ;; Add the long X options to longopts.
    2307           0 :           (dolist (tem command-line-x-option-alist)
    2308           0 :             (if (string-match "^--" (car tem))
    2309           0 :                 (push (car tem) longopts)))
    2310             : 
    2311             :           ;; Add the long NS options to longopts.
    2312           0 :           (dolist (tem command-line-ns-option-alist)
    2313           0 :             (if (string-match "^--" (car tem))
    2314           0 :                 (push (list (car tem)) longopts)))
    2315             : 
    2316             :           ;; Loop, processing options.
    2317           0 :           (while command-line-args-left
    2318           0 :             (let* ((argi (car command-line-args-left))
    2319           0 :                    (orig-argi argi)
    2320             :                    argval completion)
    2321           0 :               (setq command-line-args-left (cdr command-line-args-left))
    2322             : 
    2323             :               ;; Do preliminary decoding of the option.
    2324           0 :               (if just-files
    2325             :                   ;; After --, don't look for options; treat all args as files.
    2326           0 :                   (setq argi "")
    2327             :                 ;; Convert long options to ordinary options
    2328             :                 ;; and separate out an attached option argument into argval.
    2329           0 :                 (when (string-match "\\`\\(--[^=]*\\)=" argi)
    2330           0 :                   (setq argval (substring argi (match-end 0))
    2331           0 :                         argi (match-string 1 argi)))
    2332           0 :                 (when (string-match "\\`--?[^-]" orig-argi)
    2333           0 :                   (setq completion (try-completion argi longopts))
    2334           0 :                   (if (eq completion t)
    2335           0 :                       (setq argi (substring argi 1))
    2336           0 :                     (if (stringp completion)
    2337           0 :                         (let ((elt (member completion longopts)))
    2338           0 :                           (or elt
    2339           0 :                               (error "Option `%s' is ambiguous" argi))
    2340           0 :                           (setq argi (substring (car elt) 1)))
    2341           0 :                       (setq argval nil
    2342           0 :                             argi orig-argi)))))
    2343             : 
    2344             :               ;; Execute the option.
    2345           0 :               (cond ((setq tem (assoc argi command-switch-alist))
    2346           0 :                      (if argval
    2347           0 :                          (let ((command-line-args-left
    2348           0 :                                 (cons argval command-line-args-left)))
    2349           0 :                            (funcall (cdr tem) argi))
    2350           0 :                        (funcall (cdr tem) argi)))
    2351             : 
    2352           0 :                     ((equal argi "-no-splash")
    2353           0 :                      (setq inhibit-startup-screen t))
    2354             : 
    2355           0 :                     ((member argi '("-f"      ; what the manual claims
    2356             :                                     "-funcall"
    2357           0 :                                     "-e"))  ; what the source used to say
    2358           0 :                      (setq inhibit-startup-screen t)
    2359           0 :                      (setq tem (intern (or argval (pop command-line-args-left))))
    2360           0 :                      (if (commandp tem)
    2361           0 :                          (command-execute tem)
    2362           0 :                        (funcall tem)))
    2363             : 
    2364           0 :                     ((member argi '("-eval" "-execute"))
    2365           0 :                      (setq inhibit-startup-screen t)
    2366           0 :                      (let* ((str-expr (or argval (pop command-line-args-left)))
    2367           0 :                             (read-data (read-from-string str-expr))
    2368           0 :                             (expr (car read-data))
    2369           0 :                             (end (cdr read-data)))
    2370           0 :                        (unless (= end (length str-expr))
    2371           0 :                          (error "Trailing garbage following expression: %s"
    2372           0 :                                 (substring str-expr end)))
    2373           0 :                        (eval expr)))
    2374             : 
    2375           0 :                     ((member argi '("-L" "-directory"))
    2376             :                      ;; -L :/foo adds /foo to the _end_ of load-path.
    2377           0 :                      (let (append)
    2378           0 :                        (if (string-match-p
    2379           0 :                             (format "\\`%s" path-separator)
    2380           0 :                             (setq tem (or argval (pop command-line-args-left))))
    2381           0 :                            (setq tem (substring tem 1)
    2382           0 :                                  append t))
    2383           0 :                        (setq tem (expand-file-name
    2384           0 :                                   (command-line-normalize-file-name tem)))
    2385           0 :                        (cond (append (setq load-path
    2386           0 :                                            (append load-path (list tem)))
    2387           0 :                                      (if splice (setq splice load-path)))
    2388           0 :                              (splice (setcdr splice (cons tem (cdr splice)))
    2389           0 :                                      (setq splice (cdr splice)))
    2390           0 :                              (t (setq load-path (cons tem load-path)
    2391           0 :                                       splice load-path)))))
    2392             : 
    2393           0 :                     ((member argi '("-l" "-load"))
    2394           0 :                      (let* ((file (command-line-normalize-file-name
    2395           0 :                                    (or argval (pop command-line-args-left))))
    2396             :                             ;; Take file from default dir if it exists there;
    2397             :                             ;; otherwise let `load' search for it.
    2398           0 :                             (file-ex (expand-file-name file)))
    2399           0 :                        (when (file-regular-p file-ex)
    2400           0 :                          (setq file file-ex))
    2401           0 :                        (load file nil t)))
    2402             : 
    2403             :                     ;; This is used to handle -script.  It's not clear
    2404             :                     ;; we need to document it (it is totally internal).
    2405           0 :                     ((member argi '("-scriptload"))
    2406           0 :                      (let* ((file (command-line-normalize-file-name
    2407           0 :                                    (or argval (pop command-line-args-left))))
    2408             :                             ;; Take file from default dir.
    2409           0 :                             (file-ex (expand-file-name file)))
    2410           0 :                        (load file-ex nil t t)))
    2411             : 
    2412           0 :                     ((equal argi "-insert")
    2413           0 :                      (setq inhibit-startup-screen t)
    2414           0 :                      (setq tem (or argval (pop command-line-args-left)))
    2415           0 :                      (or (stringp tem)
    2416           0 :                          (error "File name omitted from `-insert' option"))
    2417           0 :                      (insert-file-contents (command-line-normalize-file-name tem)))
    2418             : 
    2419           0 :                     ((equal argi "-kill")
    2420           0 :                      (kill-emacs t))
    2421             : 
    2422             :                     ;; This is for when they use --no-desktop with -q, or
    2423             :                     ;; don't load Desktop in their .emacs.  If desktop.el
    2424             :                     ;; _is_ loaded, it will handle this switch, and we
    2425             :                     ;; won't see it by the time we get here.
    2426           0 :                     ((equal argi "-no-desktop")
    2427           0 :                      (message "\"--no-desktop\" ignored because the Desktop package is not loaded"))
    2428             : 
    2429           0 :                     ((string-match "^\\+[0-9]+\\'" argi)
    2430           0 :                      (setq line (string-to-number argi)))
    2431             : 
    2432           0 :                     ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi)
    2433           0 :                      (setq line (string-to-number (match-string 1 argi))
    2434           0 :                            column (string-to-number (match-string 2 argi))))
    2435             : 
    2436           0 :                     ((setq tem (assoc orig-argi command-line-x-option-alist))
    2437             :                      ;; Ignore X-windows options and their args if not using X.
    2438           0 :                      (setq command-line-args-left
    2439           0 :                            (nthcdr (nth 1 tem) command-line-args-left)))
    2440             : 
    2441           0 :                     ((setq tem (assoc orig-argi command-line-ns-option-alist))
    2442             :                      ;; Ignore NS-windows options and their args if not using NS.
    2443           0 :                      (setq command-line-args-left
    2444           0 :                            (nthcdr (nth 1 tem) command-line-args-left)))
    2445             : 
    2446           0 :                     ((member argi '("-find-file" "-file" "-visit"))
    2447           0 :                      (setq inhibit-startup-screen t)
    2448             :                      ;; An explicit option to specify visiting a file.
    2449           0 :                      (setq tem (or argval (pop command-line-args-left)))
    2450           0 :                      (unless (stringp tem)
    2451           0 :                        (error "File name omitted from `%s' option" argi))
    2452           0 :                      (funcall process-file-arg tem))
    2453             : 
    2454             :                     ;; These command lines now have no effect.
    2455           0 :                     ((string-match "\\`--?\\(no-\\)?\\(uni\\|multi\\)byte$" argi)
    2456           0 :                      (display-warning 'initialization
    2457           0 :                                       (format "Ignoring obsolete arg %s" argi)))
    2458             : 
    2459           0 :                     ((equal argi "--")
    2460           0 :                      (setq just-files t))
    2461             :                     (t
    2462             :                      ;; We have almost exhausted our options. See if the
    2463             :                      ;; user has made any other command-line options available
    2464           0 :                      (let ((hooks command-line-functions)
    2465             :                            (did-hook nil))
    2466           0 :                        (while (and hooks
    2467           0 :                                    (not (setq did-hook (funcall (car hooks)))))
    2468           0 :                          (setq hooks (cdr hooks)))
    2469           0 :                        (unless did-hook
    2470             :                          ;; Presume that the argument is a file name.
    2471           0 :                          (if (string-match "\\`-" argi)
    2472           0 :                              (error "Unknown option `%s'" argi))
    2473             :                          ;; FIXME: Why do we only inhibit the startup
    2474             :                          ;; screen for -nw?
    2475           0 :                          (unless initial-window-system
    2476           0 :                            (setq inhibit-startup-screen t))
    2477           0 :                          (funcall process-file-arg orig-argi)))))
    2478             : 
    2479             :               ;; In unusual circumstances, the execution of Lisp code due
    2480             :               ;; to command-line options can cause the last visible frame
    2481             :               ;; to be deleted.  In this case, kill emacs to avoid an
    2482             :               ;; abort later.
    2483           0 :               (unless (frame-live-p (selected-frame)) (kill-emacs nil)))))))
    2484             : 
    2485           0 :     (when (eq initial-buffer-choice t)
    2486             :       ;; When `initial-buffer-choice' equals t make sure that *scratch*
    2487             :       ;; exists.
    2488           0 :       (get-buffer-create "*scratch*"))
    2489             : 
    2490             :     ;; If *scratch* exists and is empty, insert initial-scratch-message.
    2491             :     ;; Do this before switching to *scratch* below to handle bug#9605.
    2492           0 :     (and initial-scratch-message
    2493           0 :          (get-buffer "*scratch*")
    2494           0 :          (with-current-buffer "*scratch*"
    2495           0 :            (when (zerop (buffer-size))
    2496           0 :              (insert (substitute-command-keys initial-scratch-message))
    2497           0 :              (set-buffer-modified-p nil))))
    2498             : 
    2499             :     ;; Prepend `initial-buffer-choice' to `displayable-buffers'.
    2500           0 :     (when initial-buffer-choice
    2501           0 :       (let ((buf
    2502           0 :              (cond ((stringp initial-buffer-choice)
    2503           0 :                     (find-file-noselect initial-buffer-choice))
    2504           0 :                    ((functionp initial-buffer-choice)
    2505           0 :                     (funcall initial-buffer-choice))
    2506           0 :                    ((eq initial-buffer-choice t)
    2507           0 :                     (get-buffer-create "*scratch*"))
    2508             :                    (t
    2509           0 :                     (error "initial-buffer-choice must be a string, a function, or t.")))))
    2510           0 :         (unless (buffer-live-p buf)
    2511           0 :           (error "initial-buffer-choice is not a live buffer."))
    2512           0 :         (setq displayable-buffers (cons buf displayable-buffers))))
    2513             : 
    2514             :     ;; Display the first two buffers in `displayable-buffers'.  If
    2515             :     ;; `initial-buffer-choice' is non-nil, its buffer will be the
    2516             :     ;; first buffer in `displayable-buffers'.  The first buffer will
    2517             :     ;; be focused.
    2518           0 :     (let ((displayable-buffers-len (length displayable-buffers))
    2519             :           ;; `nondisplayed-buffers-p' is true if there exist buffers
    2520             :           ;; in `displayable-buffers' that were not displayed to the
    2521             :           ;; user.
    2522             :           (nondisplayed-buffers-p nil))
    2523           0 :       (when (> displayable-buffers-len 0)
    2524           0 :         (switch-to-buffer (car displayable-buffers)))
    2525           0 :       (when (> displayable-buffers-len 1)
    2526           0 :         (switch-to-buffer-other-window (car (cdr displayable-buffers)))
    2527             :         ;; Focus on the first buffer.
    2528           0 :         (other-window -1))
    2529           0 :       (when (> displayable-buffers-len 2)
    2530           0 :         (setq nondisplayed-buffers-p t))
    2531             : 
    2532           0 :       (if (or inhibit-startup-screen
    2533           0 :               initial-buffer-choice
    2534           0 :               noninteractive
    2535           0 :               (daemonp)
    2536           0 :               inhibit-x-resources)
    2537             : 
    2538             :           ;; Not displaying a startup screen.  Display *Buffer List* if
    2539             :           ;; there exist buffers that were not displayed.
    2540           0 :           (when (and nondisplayed-buffers-p
    2541           0 :                      (not noninteractive)
    2542           0 :                      (not inhibit-startup-buffer-menu))
    2543           0 :             (list-buffers))
    2544             : 
    2545             :         ;; Display a startup screen, after some preparations.
    2546             : 
    2547             :         ;; If there are no switches to process, we might as well
    2548             :         ;; run this hook now, and there may be some need to do it
    2549             :         ;; before doing any output.
    2550           0 :         (run-hooks 'emacs-startup-hook 'term-setup-hook)
    2551             : 
    2552             :         ;; It's important to notice the user settings before we
    2553             :         ;; display the startup message; otherwise, the settings
    2554             :         ;; won't take effect until the user gives the first
    2555             :         ;; keystroke, and that's distracting.
    2556           0 :         (when (fboundp 'frame-notice-user-settings)
    2557           0 :           (frame-notice-user-settings))
    2558             : 
    2559             :         ;; If there are no switches to process, we might as well
    2560             :         ;; run this hook now, and there may be some need to do it
    2561             :         ;; before doing any output.
    2562           0 :         (run-hooks 'window-setup-hook)
    2563             : 
    2564           0 :         (setq inhibit-startup-hooks t)
    2565             : 
    2566             :         ;; ;; Do this now to avoid an annoying delay if the user
    2567             :         ;; ;; clicks the menu bar during the sit-for.
    2568             :         ;; (when (display-popup-menus-p)
    2569             :         ;;      (precompute-menubar-bindings))
    2570             :         ;; (with-no-warnings
    2571             :         ;;      (setq menubar-bindings-done t))
    2572             : 
    2573           0 :         (display-startup-screen (> displayable-buffers-len 0))))))
    2574             : 
    2575             : (defun command-line-normalize-file-name (file)
    2576             :   "Collapse multiple slashes to one, to handle non-Emacs file names."
    2577           1 :   (save-match-data
    2578             :     ;; Use arg 1 so that we don't collapse // at the start of the file name.
    2579             :     ;; That is significant on some systems.
    2580             :     ;; However, /// at the beginning is supposed to mean just /, not //.
    2581           1 :     (if (string-match
    2582           1 :          (if (memq system-type '(ms-dos windows-nt))
    2583             :              "^\\([\\/][\\/][\\/]\\)+"
    2584           1 :            "^///+")
    2585           1 :          file)
    2586           1 :         (setq file (replace-match "/" t t file)))
    2587           1 :     (if (memq system-type '(ms-dos windows-nt))
    2588           0 :         (while (string-match "\\([\\/][\\/]\\)+" file 1)
    2589           0 :           (setq file (replace-match "/" t t file)))
    2590           1 :       (while (string-match "//+" file 1)
    2591           1 :         (setq file (replace-match "/" t t file))))
    2592           1 :     file))
    2593             : 
    2594             : ;;; startup.el ends here

Generated by: LCOV version 1.12