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
|