mirrored from git://git.sv.gnu.org/emacs.git
-
Notifications
You must be signed in to change notification settings - Fork 1.3k
/
Copy pathstartup.el
2957 lines (2700 loc) · 123 KB
/
startup.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; startup.el --- process Emacs shell arguments -*- lexical-binding: t -*-
;; Copyright (C) 1985-1986, 1992, 1994-2025 Free Software Foundation,
;; Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This file parses the command line and gets Emacs running. Options
;; on the command line are handled in precedence order. For priorities
;; see the structure standard_args in the emacs.c file.
;;; Code:
(setq top-level '(normal-top-level))
(defvar command-line-processed nil
"Non-nil once command line has been processed.")
(defgroup initialization nil
"Emacs start-up procedure."
:group 'environment)
(defcustom initial-buffer-choice nil
"Buffer to show after starting Emacs.
If the value is nil and `inhibit-startup-screen' is nil, show the
startup screen. If the value is a string, switch to a buffer
visiting the file or directory that the string specifies. If the
value is a function, call it with no arguments and switch to the buffer
that it returns. If t, open the `*scratch*' buffer.
When `initial-buffer-choice' is non-nil, the startup screen is
inhibited.
If you use `emacsclient' with no target file, then it obeys any
string or function value that this variable has."
:type '(choice
(const :tag "Startup screen" nil)
(directory :tag "Directory" :value "~/")
(file :tag "File" :value "~/.emacs")
;; Note sure about hard-coding this as an option...
(const :tag "Remember Mode notes buffer" remember-notes)
(function :tag "Function")
(const :tag "Lisp scratch buffer" t))
:version "23.1")
(defvaralias 'inhibit-splash-screen 'inhibit-startup-screen)
(defvaralias 'inhibit-startup-message 'inhibit-startup-screen)
(defcustom inhibit-startup-screen nil
"Non-nil inhibits the startup screen.
This is for use in your personal init file (but NOT site-start.el),
once you are familiar with the contents of the startup screen."
:type 'boolean)
(defvar startup-screen-inhibit-startup-screen nil)
;; The mechanism used to ensure that only end users can disable this
;; message is not complex. Clearly, it is possible for a determined
;; system administrator to inhibit this message anyway, but at least
;; they will do so with knowledge of why the Emacs developers think
;; this is a bad idea.
(defcustom inhibit-startup-echo-area-message nil
"Non-nil inhibits the initial startup echo area message.
The startup message is in the echo area as it provides information
about GNU Emacs and the GNU system in general, which we want all
users to see. As this is the least intrusive startup message,
this variable gets specialized treatment to prevent the message
from being disabled site-wide by systems administrators, while
still allowing individual users to do so.
Setting this variable takes effect only if you do it with the
customization buffer or if your init file contains a line of this
form:
(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\")
If your init file is byte-compiled, use the following form
instead:
(eval \\='(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\"))
Thus, someone else using a copy of your init file will see the
startup message unless he personally acts to inhibit it."
:type '(choice (const :tag "Don't inhibit")
(string :tag "Enter your user name, to inhibit")))
(defcustom inhibit-default-init nil
"Non-nil inhibits loading the `default' library."
:type 'boolean)
(defcustom inhibit-startup-buffer-menu nil
"Non-nil inhibits display of buffer list when more than 2 files are loaded."
:type 'boolean)
(defvar command-switch-alist nil
"Alist of command-line switches.
Elements look like (SWITCH-STRING . HANDLER-FUNCTION).
HANDLER-FUNCTION receives the switch string as its sole argument;
the remaining command-line args are in the variable `command-line-args-left'.")
(with-no-warnings
(defvaralias 'argv 'command-line-args-left
"List of command-line args not yet processed.
This is a convenience alias, so that one can write (pop argv)
inside of --eval command line arguments in order to access
following arguments.
See also `server-eval-args-left' for a similar variable which
works for invocations of \"emacsclient --eval\"."))
(internal-make-var-non-special 'argv)
(defvar command-line-args-left nil
"List of command-line args not yet processed.")
(with-no-warnings
(defvar argi nil
"Current command-line argument."))
(internal-make-var-non-special 'argi)
(defvar command-line-functions nil ;; lrs 7/31/89
"List of functions to process unrecognized command-line arguments.
Each function should access the dynamically bound variables
`argi' (the current argument) and `command-line-args-left' (the remaining
arguments). The function should return non-nil only if it recognizes and
processes `argi'. If it does so, it may consume successive arguments by
altering `command-line-args-left' to remove them.")
(defvar command-line-default-directory nil
"Default directory to use for command line arguments.
This is normally copied from `default-directory' when Emacs starts.")
;; This is here, rather than in x-win.el, so that we can ignore these
;; options when we are not using X.
(defconst command-line-x-option-alist
'(("-bw" 1 x-handle-numeric-switch border-width)
("-d" 1 x-handle-display)
("-display" 1 x-handle-display)
("-name" 1 x-handle-name-switch)
("-title" 1 x-handle-switch title)
("-T" 1 x-handle-switch title)
("-r" 0 x-handle-switch reverse t)
("-rv" 0 x-handle-switch reverse t)
("-reverse" 0 x-handle-switch reverse t)
("-reverse-video" 0 x-handle-switch reverse t)
("-fn" 1 x-handle-switch font)
("-font" 1 x-handle-switch font)
("-fs" 0 x-handle-initial-switch fullscreen fullboth)
("-fw" 0 x-handle-initial-switch fullscreen fullwidth)
("-fh" 0 x-handle-initial-switch fullscreen fullheight)
("-mm" 0 x-handle-initial-switch fullscreen maximized)
("-ib" 1 x-handle-numeric-switch internal-border-width)
("-g" 1 x-handle-geometry)
("-lsp" 1 x-handle-numeric-switch line-spacing)
("-geometry" 1 x-handle-geometry)
("-fg" 1 x-handle-switch foreground-color)
("-foreground" 1 x-handle-switch foreground-color)
("-bg" 1 x-handle-switch background-color)
("-background" 1 x-handle-switch background-color)
("-ms" 1 x-handle-switch mouse-color)
("-nbi" 0 x-handle-switch icon-type nil)
("-iconic" 0 x-handle-iconic)
("-xrm" 1 x-handle-xrm-switch)
("-cr" 1 x-handle-switch cursor-color)
("-vb" 0 x-handle-switch vertical-scroll-bars t)
("-hb" 0 x-handle-switch horizontal-scroll-bars t)
("-bd" 1 x-handle-switch)
("--border-width" 1 x-handle-numeric-switch border-width)
("--display" 1 x-handle-display)
("--name" 1 x-handle-name-switch)
("--title" 1 x-handle-switch title)
("--reverse-video" 0 x-handle-switch reverse t)
("--font" 1 x-handle-switch font)
("--fullscreen" 0 x-handle-initial-switch fullscreen fullboth)
("--fullwidth" 0 x-handle-initial-switch fullscreen fullwidth)
("--fullheight" 0 x-handle-initial-switch fullscreen fullheight)
("--maximized" 0 x-handle-initial-switch fullscreen maximized)
("--internal-border" 1 x-handle-numeric-switch internal-border-width)
("--geometry" 1 x-handle-geometry)
("--foreground-color" 1 x-handle-switch foreground-color)
("--background-color" 1 x-handle-switch background-color)
("--mouse-color" 1 x-handle-switch mouse-color)
("--no-bitmap-icon" 0 x-handle-no-bitmap-icon)
("--iconic" 0 x-handle-iconic)
("--xrm" 1 x-handle-xrm-switch)
("--cursor-color" 1 x-handle-switch cursor-color)
("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t)
("--line-spacing" 1 x-handle-numeric-switch line-spacing)
("--border-color" 1 x-handle-switch border-color)
("--smid" 1 x-handle-smid)
("--parent-id" 1 x-handle-parent-id))
"Alist of X Windows options.
Each element has the form
(NAME NUMARGS HANDLER FRAME-PARAM VALUE)
where NAME is the option name string, NUMARGS is the number of arguments
that the option accepts, HANDLER is a function to call to handle the option.
FRAME-PARAM (optional) is the frame parameter this option specifies,
and VALUE is the value which is given to that frame parameter
\(most options use the argument for this, so VALUE is not present).")
(defconst command-line-ns-option-alist
'(("-NSAutoLaunch" 1 ns-ignore-1-arg)
("-NXAutoLaunch" 1 ns-ignore-1-arg)
("-macosx" 0 ignore)
("-NSHost" 1 ns-ignore-1-arg)
("-_NSMachLaunch" 1 ns-ignore-1-arg)
("-MachLaunch" 1 ns-ignore-1-arg)
("-NXOpen" 1 ns-ignore-1-arg)
("-NSOpen" 1 ns-handle-nxopen)
("-NXOpenTemp" 1 ns-ignore-1-arg)
("-NSOpenTemp" 1 ns-handle-nxopentemp)
("-GSFilePath" 1 ns-handle-nxopen)
;;("-bw" . x-handle-numeric-switch)
;;("-d" . x-handle-display)
;;("-display" . x-handle-display)
("-name" 1 x-handle-name-switch)
("-title" 1 x-handle-switch title)
("-T" 1 x-handle-switch title)
("-r" 0 x-handle-switch reverse t)
("-rv" 0 x-handle-switch reverse t)
("-reverse" 0 x-handle-switch reverse t)
("-fn" 1 x-handle-switch font)
("-font" 1 x-handle-switch font)
("-ib" 1 x-handle-numeric-switch internal-border-width)
("-g" 1 x-handle-geometry)
("-geometry" 1 x-handle-geometry)
("-fg" 1 x-handle-switch foreground-color)
("-foreground" 1 x-handle-switch foreground-color)
("-bg" 1 x-handle-switch background-color)
("-background" 1 x-handle-switch background-color)
; ("-ms" 1 x-handle-switch mouse-color)
("-itype" 0 x-handle-switch icon-type t)
("-i" 0 x-handle-switch icon-type t)
("-iconic" 0 x-handle-iconic icon-type t)
;;("-xrm" . x-handle-xrm-switch)
("-cr" 1 x-handle-switch cursor-color)
("-vb" 0 x-handle-switch vertical-scroll-bars t)
("-hb" 0 x-handle-switch horizontal-scroll-bars t)
("-bd" 1 x-handle-switch)
;; ("--border-width" 1 x-handle-numeric-switch border-width)
;; ("--display" 1 ns-handle-display)
("--name" 1 x-handle-name-switch)
("--title" 1 x-handle-switch title)
("--reverse-video" 0 x-handle-switch reverse t)
("--font" 1 x-handle-switch font)
("--internal-border" 1 x-handle-numeric-switch internal-border-width)
("--geometry" 1 x-handle-geometry)
("--foreground-color" 1 x-handle-switch foreground-color)
("--background-color" 1 x-handle-switch background-color)
("--mouse-color" 1 x-handle-switch mouse-color)
("--icon-type" 0 x-handle-switch icon-type t)
("--iconic" 0 x-handle-iconic)
;; ("--xrm" 1 ns-handle-xrm-switch)
("--cursor-color" 1 x-handle-switch cursor-color)
("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t)
("--border-color" 1 x-handle-switch border-width))
"Alist of NS options.
Each element has the form
(NAME NUMARGS HANDLER FRAME-PARAM VALUE)
where NAME is the option name string, NUMARGS is the number of arguments
that the option accepts, HANDLER is a function to call to handle the option.
FRAME-PARAM (optional) is the frame parameter this option specifies,
and VALUE is the value which is given to that frame parameter
\(most options use the argument for this, so VALUE is not present).")
(defvar before-init-hook nil
"Normal hook run after handling urgent options but before loading init files.")
(defvar after-init-hook nil
"Normal hook run after initializing the Emacs session.
It is run after Emacs loads the init file, `default' library, the
abbrevs file, and additional Lisp packages (if any), and setting
the value of `after-init-time'.
There is no `condition-case' around the running of this hook;
therefore, if `debug-on-error' is non-nil, an error in one of
these functions will invoke the debugger.")
(defvar emacs-startup-hook nil
"Normal hook run after loading init files and handling the command line.")
(defvar term-setup-hook nil
"Normal hook run immediately after `emacs-startup-hook'.
In new code, there is no reason to use this instead of `emacs-startup-hook'.
If you want to execute terminal-specific Lisp code, for example
to override the definitions made by the terminal-specific file,
see `tty-setup-hook'.")
(make-obsolete-variable 'term-setup-hook
"use either `emacs-startup-hook' or \
`tty-setup-hook' instead." "24.4")
(defvar inhibit-startup-hooks nil
"Non-nil means don't run some startup hooks, because we already did.
Currently this applies to: `emacs-startup-hook', `term-setup-hook',
and `window-setup-hook'.")
(defvar early-init-file nil
"File name, including directory, of user's early init file.
See `user-init-file'. The only difference is that
`early-init-file' is not set during the course of evaluating the
early init file.")
(defvar keyboard-type nil
"The brand of keyboard you are using.
This variable is used to define the proper function and keypad
keys for use under X. It is used in a fashion analogous to the
environment variable TERM.")
(make-obsolete-variable 'keyboard-type nil "28.1")
(internal-make-var-non-special 'keyboard-type)
(defvar window-setup-hook nil
"Normal hook run after loading init files and handling the command line.
This is very similar to `emacs-startup-hook'. The only difference
is that this hook runs after frame parameters have been set up in
response to any settings from your init file. Unless this matters
to you, use `emacs-startup-hook' instead. (The name of this hook
is due to historical reasons, and does not reflect its purpose very well.)")
(defcustom initial-major-mode 'lisp-interaction-mode
"Major mode command symbol to use for the initial `*scratch*' buffer."
:type 'function)
(defvar init-file-user nil
"Identity of user whose init file is or was read.
The value is nil if `-q' or `--no-init-file' was specified,
meaning do not load any init file.
Otherwise, the value may be an empty string, meaning
use the init file for the user who originally logged in,
or it may be a string containing a user's name meaning
use that person's init file.
In either of the latter cases, `(concat \"~\" init-file-user \"/\")'
evaluates to the name of the directory where the init file was
looked for.
Setting `init-file-user' does not prevent Emacs from loading
`site-start.el'. The only way to do that is to use `--no-site-file'.")
(defcustom site-run-file "site-start"
"File containing site-wide run-time initializations.
This file is loaded at run-time before `user-init-file'. It contains
inits that need to be in place for the entire site, but which, due to
their higher incidence of change, don't make sense to put into Emacs's
dump file. Thus, the run-time load order is: 1. file described in
this variable, if non-nil; 2. `user-init-file'; 3. `default.el'.
Don't use the `site-start.el' file for things some users may not like.
Put them in `default.el' instead, so that users can more easily
override them. Users can prevent loading `default.el' with the `-q'
option or by setting `inhibit-default-init' in their own init files,
but inhibiting `site-start.el' requires `--no-site-file', which
is less convenient.
This variable is defined for customization so as to make
it visible in the relevant context. However, actually customizing it
is not allowed, since it would not work anyway. The only way to set
this variable usefully is to set it while building and dumping Emacs."
:type '(choice (const :tag "none" nil) string)
:initialize #'custom-initialize-default
:set (lambda (_variable _value)
(error "Customizing `site-run-file' does not work")))
(make-obsolete-variable 'system-name "use (system-name) instead" "25.1")
(defcustom mail-host-address nil
"The name of this machine, for use in constructing email addresses.
If this is nil, Emacs uses `system-name'."
:type '(choice (const nil) string)
:group 'mail)
(defcustom user-mail-address
(or (getenv "EMAIL")
(concat (user-login-name) "@" (or mail-host-address (system-name))))
"The email address of the current user.
This defaults to either: the value of EMAIL environment variable; or
user@host, using `user-login-name' and `mail-host-address' (or `system-name')."
:initialize #'custom-initialize-delay
:set-after '(mail-host-address)
:type 'string
:group 'mail)
(defcustom auto-save-list-file-prefix
(cond ((eq system-type 'ms-dos)
;; MS-DOS cannot have initial dot, and allows only 8.3 names
(concat user-emacs-directory "auto-save.list/_s"))
(t
(concat user-emacs-directory "auto-save-list/.saves-")))
"Prefix for generating `auto-save-list-file-name'.
This is used after reading your init file to initialize
`auto-save-list-file-name', by appending Emacs's pid and the system name,
if you have not already set `auto-save-list-file-name' yourself.
Directories in the prefix will be created if necessary.
Set this to nil if you want to prevent `auto-save-list-file-name'
from being initialized."
:initialize #'custom-initialize-delay
:type '(choice (const :tag "Don't record a session's auto save list" nil)
string)
:group 'auto-save)
(defvar emacs-basic-display nil)
(defvar init-file-debug nil)
(defvar init-file-had-error nil
"Non-nil if there was an error loading the user's init file.")
(defvar normal-top-level-add-subdirs-inode-list nil)
(defvar no-blinking-cursor nil)
(defcustom tutorial-directory
(file-name-as-directory (expand-file-name "tutorials" data-directory))
"Directory containing the Emacs TUTORIAL files."
:group 'installation
:type 'directory
:initialize #'custom-initialize-delay)
(defun normal-top-level-add-subdirs-to-load-path ()
"Recursively add all subdirectories of `default-directory' to `load-path'.
More precisely, this uses only the subdirectories whose names
start with letters or digits; it excludes any subdirectory named `RCS'
or `CVS', and any subdirectory that contains a file named `.nosearch'."
(let (dirs
attrs
(pending (list default-directory)))
;; This loop does a breadth-first tree walk on DIR's subtree,
;; putting each subdir into DIRS as its contents are examined.
(while pending
(push (pop pending) dirs)
(let* ((this-dir (car dirs))
(contents (directory-files this-dir))
(default-directory this-dir)
(canonicalized (if (fboundp 'w32-untranslated-canonical-name)
(w32-untranslated-canonical-name this-dir))))
;; The Windows version doesn't report meaningful inode numbers, so
;; use the canonicalized absolute file name of the directory instead.
(setq attrs (or canonicalized
(file-attribute-file-identifier
(file-attributes this-dir))))
(unless (member attrs normal-top-level-add-subdirs-inode-list)
(push attrs normal-top-level-add-subdirs-inode-list)
(dolist (file contents)
(and (string-match "\\`[[:alnum:]]" file)
;; The lower-case variants of RCS and CVS are for DOS/Windows.
(not (member file '("RCS" "CVS" "rcs" "cvs")))
(file-directory-p file)
(let ((expanded (expand-file-name file)))
(or (file-exists-p (expand-file-name ".nosearch" expanded))
(setq pending (nconc pending (list expanded))))))))))
(normal-top-level-add-to-load-path (cdr (nreverse dirs)))))
(defun normal-top-level-add-to-load-path (dirs)
"This function is called from a subdirs.el file.
It assumes that `default-directory' is the directory in which the
subdirs.el file exists, and it adds to `load-path' the subdirs of
that directory as specified in DIRS. Normally the elements of
DIRS are relative."
(let ((tail load-path)
(thisdir (directory-file-name default-directory)))
(while (and tail
;;Don't go all the way to the nil terminator.
(cdr tail)
(not (equal thisdir (car tail)))
(not (and (memq system-type '(ms-dos windows-nt))
(equal (downcase thisdir) (downcase (car tail))))))
(setq tail (cdr tail)))
;;Splice the new section in.
(when tail
(setcdr tail (append (mapcar #'expand-file-name dirs) (cdr tail))))))
;; The default location for XDG-convention Emacs init files.
(defconst startup--xdg-config-default "~/.config/emacs/")
;; The location for XDG-convention Emacs init files.
(defvar startup--xdg-config-home-emacs)
;; Return the name of the init file directory for Emacs, assuming
;; XDG-DIR is the XDG location and USER-NAME is the user name. If
;; USER-NAME is nil or "", use the current user. Prefer the XDG
;; location only if the .emacs.d location does not exist.
(defun startup--xdg-or-homedot (xdg-dir user-name)
(let ((emacs-d-dir (concat "~" user-name
(if (eq system-type 'ms-dos)
"/_emacs.d/"
"/.emacs.d/"))))
(cond
((or (file-exists-p emacs-d-dir)
(if (eq system-type 'windows-nt)
(if (file-directory-p (concat "~" user-name))
(directory-files (concat "~" user-name) nil
"\\`[._]emacs\\(\\.elc?\\)?\\'"))
(file-exists-p (concat "~" init-file-user
(if (eq system-type 'ms-dos)
"/_emacs"
"/.emacs")))))
emacs-d-dir)
((file-exists-p xdg-dir)
xdg-dir)
(t emacs-d-dir))))
(defvar native-comp-eln-load-path)
(defvar native-comp-jit-compilation)
(defvar native-comp-enable-subr-trampolines)
(defvar startup--original-eln-load-path nil
"Original value of `native-comp-eln-load-path'.")
(defun startup-redirect-eln-cache (cache-directory)
"Redirect the user's eln-cache directory to CACHE-DIRECTORY.
CACHE-DIRECTORY must be a single directory, a string.
This function destructively changes `native-comp-eln-load-path'
so that its first element is CACHE-DIRECTORY. If CACHE-DIRECTORY
is not an absolute file name, it is interpreted relative
to `user-emacs-directory'.
For best results, call this function in your early-init file,
so that the rest of initialization and package loading uses
the updated value."
;; Remove the original eln-cache.
(setq native-comp-eln-load-path (cdr native-comp-eln-load-path))
;; Add the new eln-cache.
(push (expand-file-name (file-name-as-directory cache-directory)
user-emacs-directory)
native-comp-eln-load-path))
(defun startup--update-eln-cache ()
"Update the user eln-cache directory due to user customizations."
;; Don't override user customizations!
(when (equal native-comp-eln-load-path
startup--original-eln-load-path)
(startup-redirect-eln-cache "eln-cache")
(setq startup--original-eln-load-path
(copy-sequence native-comp-eln-load-path))))
(defun startup--rescale-elt-match-p (font-pattern font-object)
"Test whether FONT-OBJECT matches an element of `face-font-rescale-alist'.
FONT-OBJECT is a font-object that specifies a font to test.
FONT-PATTERN is the car of an element of `face-font-rescale-alist',
which can be either a regexp matching a font name or a font-spec."
(if (stringp font-pattern)
;; FONT-PATTERN is a regexp, we need the name of FONT-OBJECT to match.
(string-match-p font-pattern (font-xlfd-name font-object))
;; FONT-PATTERN is a font-spec.
(font-match-p font-pattern font-object)))
(defvar android-fonts-enumerated nil
"Whether or not fonts have been enumerated already.
On Android, Emacs uses this variable internally at startup.")
(defun normal-top-level ()
"Emacs calls this function when it first starts up.
It sets `command-line-processed', processes the command-line,
reads the initialization files, etc.
It is the default value of the variable `top-level'."
;; Initialize the Android font driver late.
;; This is done here because it needs the `mac-roman' coding system
;; to be loaded.
(when (and (featurep 'android)
(fboundp 'android-enumerate-fonts)
(not android-fonts-enumerated))
(funcall 'android-enumerate-fonts)
(setq android-fonts-enumerated t))
(if command-line-processed
(message internal--top-level-message)
(setq command-line-processed t)
(setq startup--xdg-config-home-emacs
(let ((xdg-config-home (getenv-internal "XDG_CONFIG_HOME")))
(if xdg-config-home
(concat xdg-config-home "/emacs/")
startup--xdg-config-default)))
(setq user-emacs-directory
(startup--xdg-or-homedot startup--xdg-config-home-emacs nil))
(when (featurep 'native-compile)
(unless (native-comp-available-p)
;; Disable deferred async compilation and trampoline synthesis
;; in this session. This is necessary if libgccjit is not
;; available on MS-Windows, but Emacs was built with
;; native-compilation support.
(setq native-comp-jit-compilation nil
native-comp-enable-subr-trampolines nil))
;; Form `native-comp-eln-load-path'.
(let ((path-env (getenv "EMACSNATIVELOADPATH")))
(when path-env
(dolist (path (split-string path-env path-separator))
(unless (string= "" path)
(push path native-comp-eln-load-path)))))
(push (expand-file-name "eln-cache/" user-emacs-directory)
native-comp-eln-load-path))
;; Look in each dir in load-path for a subdirs.el file. If we
;; find one, load it, which will add the appropriate subdirs of
;; that dir into load-path. This needs to be done before setting
;; the locale environment, because the latter might need to load
;; some support files.
;; Look for a leim-list.el file too. Loading it will register
;; available input methods.
(let ((tail load-path)
(lispdir (expand-file-name "../lisp" data-directory))
dir)
(while tail
(setq dir (car tail))
(let ((default-directory dir))
(load (expand-file-name "subdirs.el") t t t))
;; Do not scan standard directories that won't contain a leim-list.el.
;; https://lists.gnu.org/r/emacs-devel/2009-10/msg00502.html
;; (Except the preloaded one in lisp/leim.)
(or (string-prefix-p lispdir dir)
(let ((default-directory dir))
(load (expand-file-name "leim-list.el") t t t)))
;; We don't use a dolist loop and we put this "setq-cdr" command at
;; the end, because the subdirs.el files may add elements to the end
;; of load-path and we want to take it into account.
(setq tail (cdr tail))))
;; Set the default strings to display in mode line for end-of-line
;; formats that aren't native to this platform. This should be
;; done before calling set-locale-environment, as the latter might
;; use these mnemonics.
(cond
((memq system-type '(ms-dos windows-nt))
(setq eol-mnemonic-unix "(Unix)"
eol-mnemonic-mac "(Mac)"))
(t ; this is for Unix/GNU/Linux systems
(setq eol-mnemonic-dos "(DOS)"
eol-mnemonic-mac "(Mac)")))
(if (and (featurep 'android)
(eq system-type 'android)
(fboundp 'android-locale-for-system-language)
initial-window-system)
;; If Android windowing is enabled, derive a proper locale
;; from the system's language preferences. On Android, LANG
;; and LC_* must be set to one of the two locales the C
;; library supports, but, by contrast with other systems, the
;; C library locale does not reflect the configured system
;; language.
;;
;; For this reason, the locale from which Emacs derives a
;; default language environment is computed from such
;; preferences, rather than environment variables that the C
;; library refers to.
(set-locale-environment
(funcall 'android-locale-for-system-language))
(set-locale-environment nil))
;; Decode all default-directory's (probably, only *scratch* exists
;; at this point). default-directory of *scratch* is the basis
;; for many other file-name variables and directory lists, so it
;; is important to decode it ASAP.
(when locale-coding-system
(let ((coding (if (eq system-type 'windows-nt)
;; MS-Windows build converts all file names to
;; UTF-8 during startup.
'utf-8
locale-coding-system)))
(save-excursion
(dolist (elt (buffer-list))
(set-buffer elt)
(if default-directory
(setq default-directory
(if (eq system-type 'windows-nt)
;; We pass the decoded default-directory as
;; the 2nd arg to expand-file-name to make
;; sure it sees a multibyte string as the
;; default directory; this avoids the side
;; effect of returning a unibyte string from
;; expand-file-name because it still sees
;; the undecoded value of default-directory.
(let ((defdir (decode-coding-string default-directory
coding t)))
;; Convert backslashes to forward slashes.
(expand-file-name defdir defdir))
(decode-coding-string default-directory coding t))))))
;; Decode all the important variables and directory lists, now
;; that we know the locale's encoding. This is because the
;; values of these variables are until here unibyte undecoded
;; strings created by build_unibyte_string. data-directory in
;; particular is used to construct many other standard
;; directory names, so it must be decoded ASAP. Note that
;; charset-map-path cannot be decoded here, since we could
;; then be trapped in infinite recursion below, when we load
;; subdirs.el, because encoding a directory name might need to
;; load a charset map, which will want to encode
;; charset-map-path, which will want to load the same charset
;; map... So decoding of charset-map-path is delayed until
;; further down below.
(dolist (pathsym '(load-path exec-path))
(let ((path (symbol-value pathsym)))
(if (listp path)
(set pathsym (mapcar (lambda (dir)
(decode-coding-string dir coding t))
path)))))
(when (featurep 'native-compile)
(let ((npath (symbol-value 'native-comp-eln-load-path)))
(set 'native-comp-eln-load-path
(mapcar (lambda (dir)
;; Call expand-file-name to remove all the
;; pesky ".." from the directory names in
;; native-comp-eln-load-path.
(expand-file-name
(decode-coding-string dir coding t)))
npath)))
(setq startup--original-eln-load-path
(copy-sequence native-comp-eln-load-path)))
(dolist (filesym '(data-directory doc-directory exec-directory
installation-directory
invocation-directory invocation-name
source-directory
shared-game-score-directory))
(let ((file (symbol-value filesym)))
(if (stringp file)
(set filesym (decode-coding-string file coding t)))))))
(let ((dir default-directory))
(with-current-buffer "*Messages*"
(messages-buffer-mode)
;; Give *Messages* the same default-directory as *scratch*,
;; just to keep things predictable.
(setq default-directory (or dir (expand-file-name "~/")))))
;; `user-full-name' is now known; reset its standard-value here.
(put 'user-full-name 'standard-value
(list (default-value 'user-full-name)))
;; If the PWD environment variable isn't accurate, delete it.
(let ((pwd (getenv "PWD")))
(and pwd
(or (and default-directory
(ignore-errors
(equal (file-attributes
(file-name-as-directory pwd))
(file-attributes
(file-name-as-directory default-directory)))))
(setq process-environment
(delete (concat "PWD=" pwd)
process-environment)))))
;; Now, that other directories were searched, and any charsets we
;; need for encoding them are already loaded, we are ready to
;; decode charset-map-path.
(if (listp charset-map-path)
(let ((coding (if (eq system-type 'windows-nt)
'utf-8
locale-coding-system)))
(setq charset-map-path
(mapcar (lambda (dir)
(decode-coding-string dir coding t))
charset-map-path))))
(if default-directory
(setq default-directory (abbreviate-file-name default-directory))
(display-warning 'initialization "Error setting default-directory"))
(let ((old-face-font-rescale-alist face-font-rescale-alist))
(unwind-protect
(command-line)
(when (featurep 'native-compile)
(startup--update-eln-cache))
;; Do this again, in case .emacs defined more abbreviations.
(if default-directory
(setq default-directory (abbreviate-file-name default-directory)))
;; Specify the file for recording all the auto save files of this session.
;; This is used by recover-session.
(or auto-save-list-file-name
(and auto-save-list-file-prefix
(setq auto-save-list-file-name
;; Under MS-DOS our PID is almost always reused between
;; Emacs invocations. We need something more unique.
(cond ((eq system-type 'ms-dos)
;; We are going to access the auto-save
;; directory, so make sure it exists.
(make-directory
(file-name-directory auto-save-list-file-prefix)
t)
(concat
(make-temp-name
(expand-file-name
auto-save-list-file-prefix))
"~"))
(t
(expand-file-name
(format "%s%d-%s~"
auto-save-list-file-prefix
(emacs-pid)
(system-name))))))))
(unless inhibit-startup-hooks
(run-hooks 'emacs-startup-hook 'term-setup-hook))
;; Don't do this if we failed to create the initial frame,
;; for instance due to a dense colormap.
(when (or frame-initial-frame
;; If frame-initial-frame has no meaning, do this anyway.
(not (and initial-window-system
(not noninteractive)
(not (eq initial-window-system 'pc)))))
;; FIXME: The user's init file may change
;; face-font-rescale-alist. However, the default face
;; already has an assigned font object, which does not take
;; face-font-rescale-alist into account. For such
;; situations, we ought to have a way to find all font
;; objects and regenerate them; currently we do not. As a
;; workaround, we specifically reset the default face's :font
;; attribute here, if it was rescaled. See bug#1785.
(when (and (display-multi-font-p)
(not (eq face-font-rescale-alist
old-face-font-rescale-alist))
(assoc (face-attribute 'default :font)
face-font-rescale-alist
#'startup--rescale-elt-match-p))
(set-face-attribute 'default nil :font (font-spec)))
;; Modify the initial frame based on what .emacs puts into
;; ...-frame-alist.
(if (fboundp 'frame-notice-user-settings)
(frame-notice-user-settings))
;; Set the faces for the initial background mode even if
;; frame-notice-user-settings didn't (such as on a tty).
;; frame-set-background-mode is idempotent, so it won't
;; cause any harm if it's already been done.
(if (fboundp 'frame-set-background-mode)
(frame-set-background-mode (selected-frame))))
;; Now we know the user's default font, so add it to the menu.
(if (fboundp 'font-menu-add-default)
(font-menu-add-default))
(unless inhibit-startup-hooks
(run-hooks 'window-setup-hook))))
;; Subprocesses of Emacs do not have direct access to the terminal, so
;; unless told otherwise they should only assume a dumb terminal.
;; We are careful to do it late (after term-setup-hook), although the
;; new multi-tty code does not use $TERM any more there anyway.
(setenv "TERM" "dumb")
;; Similarly, a subprocess should not try to invoke a pager, as most
;; pagers will fail in a dumb terminal. Many programs default to
;; using "less" when PAGER is unset, so set PAGER to "cat"; using cat
;; as a pager is equivalent to not using a pager at all.
(when (executable-find "cat")
(setenv "PAGER" "cat"))
;; Remove DISPLAY from the process-environment as well. This allows
;; `callproc.c' to give it a useful adaptive default which is either
;; the value of the `display' frame-parameter or the DISPLAY value
;; from initial-environment.
(let ((display (frame-parameter nil 'display)))
;; Be careful which DISPLAY to remove from process-environment: follow
;; the logic of `callproc.c'.
(if (stringp display)
(setq display (concat "DISPLAY=" display))
(let ((env initial-environment))
(while (and env (or (not (string-match "\\`DISPLAY=" (car env)))
(progn
(setq display (car env))
nil)))
(setq env (cdr env)))))
(when display
(setq process-environment (delete display process-environment))))))
;; Precompute the keyboard equivalents in the menu bar items.
;; Command-line options supported by tty's:
(defconst tty-long-option-alist
'(("--name" . "-name")
("--title" . "-T")
("--reverse-video" . "-reverse")
("--foreground-color" . "-fg")
("--background-color" . "-bg")
("--color" . "-color")))
;; FIXME: this var unused?
(defconst tool-bar-images-pixel-height 24
"Height in pixels of images in the tool-bar.")
(cl-defgeneric handle-args-function (args)
"Method for processing window-system dependent command-line arguments.
Window system startup files should add their own function to this
method, which should parse the command line arguments. Those
pertaining to the window system should be processed and removed
from the returned command line.")
(cl-defmethod handle-args-function (args &context (window-system nil))
(tty-handle-args args))
(cl-defgeneric window-system-initialization (&optional _display)
"Method for window-system initialization.
Window-system startup files should add their own implementation
to this method. The function should initialize the window system environment
to prepare for opening the first frame (e.g. open a connection to an X server)."
nil)
(defun tty-handle-args (args)
"Handle the X-like command-line arguments \"-fg\", \"-bg\", \"-name\", etc."
(let (rest)
(while (and args
(not (equal (car args) "--")))
(let* ((argi (pop args))
(orig-argi argi)
argval completion)
;; Check for long options with attached arguments
;; and separate out the attached option argument into argval.
(when (string-match "^\\(--[^=]*\\)=" argi)
(setq argval (substring argi (match-end 0))
argi (match-string 1 argi)))
(when (string-match "^--" argi)
(setq completion (try-completion argi tty-long-option-alist))
(if (eq completion t)
;; Exact match for long option.
(setq argi (cdr (assoc argi tty-long-option-alist)))
(if (stringp completion)
(let ((elt (assoc completion tty-long-option-alist)))
;; Check for abbreviated long option.
(or elt
(error "Option `%s' is ambiguous" argi))
(setq argi (cdr elt)))
;; Check for a short option.
(setq argval nil
argi orig-argi))))
(cond ((member argi '("-fg" "-foreground"))
(push (cons 'foreground-color (or argval (pop args)))
default-frame-alist))
((member argi '("-bg" "-background"))
(push (cons 'background-color (or argval (pop args)))
default-frame-alist))
((member argi '("-T" "-name"))
(unless argval (setq argval (pop args)))
(push (cons 'title
(if (stringp argval)
argval
(let ((case-fold-search t)
i)
(setq argval (copy-sequence invocation-name))
;; Change any . or * characters in name to
;; hyphens, so as to emulate behavior on X.
(while
(setq i (string-match "[.*]" argval))
(aset argval i ?-))
argval)))
default-frame-alist))
((member argi '("-r" "-rv" "-reverse"))
(push '(reverse . t)
default-frame-alist))
((equal argi "-color")
(unless argval (setq argval 8)) ; default --color means 8 ANSI colors
(push (cons 'tty-color-mode
(cond
((numberp argval) argval)
((string-match "-?[0-9]+" argval)
(string-to-number argval))
(t (intern argval))))
default-frame-alist))
(t
(push argi rest)))))
(nconc (nreverse rest) args)))
(declare-function x-get-resource "frame.c"
(attribute class &optional component subclass))
(declare-function tool-bar-mode "tool-bar" (&optional arg))
(declare-function tool-bar-setup "tool-bar")
(defvar server-name)
(defvar server-process)
(defun startup--setup-quote-display (&optional style)
"If needed, display ASCII approximations to curved quotes.
Do this by modifying `standard-display-table'. Optional STYLE
specifies the desired quoting style, as in `text-quoting-style'.
If STYLE is nil, display appropriately for the terminal."
(let ((repls (let ((style-repls (assq style '((grave . "`'\"\"")
(straight . "''\"\"")))))
(if style-repls (cdr style-repls) (make-vector 4 nil))))
glyph-count)
;; REPLS is a sequence of the four replacements for "‘’“”", respectively.
;; If STYLE is nil, infer REPLS from terminal characteristics.
(unless style
;; On a terminal that supports glyph codes,
;; GLYPH-COUNT[i] is the number of times that glyph code I
;; represents either an ASCII character or one of the 4
;; quote characters. This assumes glyph codes are valid
;; Elisp characters, which is a safe assumption in practice.
(when (integerp (internal-char-font nil (max-char)))
(setq glyph-count (make-char-table nil 0))
(dotimes (i 132)
(let ((glyph (internal-char-font