/
startup.el
2424 lines (2196 loc) · 92.5 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-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; 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 <http://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, visit the specified file
or directory using `find-file'. If t, open the `*scratch*'
buffer."
:type '(choice
(const :tag "Startup screen" nil)
(directory :tag "Directory" :value "~/")
(file :tag "File" :value "~/.emacs")
(const :tag "Lisp scratch buffer" t))
:version "23.1"
:group 'initialization)
(defcustom show-scratch-buffer-on-startup t
"Show the initial frame if it contains the *scratch* buffer on startup.
If nil, the initial frame remains hidden if the current buffer is *scratch*."
:type 'boolean
:group 'initialization)
(defcustom inhibit-startup-screen nil
"Non-nil inhibits the startup screen.
This is for use in your personal init file,
once you are familiar with the contents of the startup screen."
:type 'boolean
:group 'initialization)
(defvaralias 'inhibit-splash-screen 'inhibit-startup-screen)
(defvaralias 'inhibit-startup-message 'inhibit-startup-screen)
(defvar startup-screen-inhibit-startup-screen nil)
;; FIXME? Why does this get such weirdly extreme treatment, when the
;; more important inhibit-startup-screen does not.
(defcustom inhibit-startup-echo-area-message nil
"Non-nil inhibits the initial startup echo area message.
Setting this variable takes effect
only if you do it with the customization buffer
or if your `.emacs' file contains a line of this form:
(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\")
If your `.emacs' 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 `.emacs' 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"))
:group 'initialization)
(defcustom inhibit-default-init nil
"Non-nil inhibits loading the `default' library."
:type 'boolean
:group 'initialization)
(defcustom inhibit-startup-buffer-menu nil
"Non-nil inhibits display of buffer list when more than 2 files are loaded."
:type 'boolean
:group 'initialization)
(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'.")
(defvar command-line-args-left nil
"List of command-line args not yet processed.")
(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.")
(internal-make-var-non-special 'argv)
(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" . x-handle-geometry)
;;("-geometry" . 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 ns-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 loading the init files, `~/.emacs' and `default.el'.
There is no `condition-case' around the running of these functions;
therefore, if you set `debug-on-error' non-nil in `.emacs',
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 after loading terminal-specific Lisp code.
It also follows `emacs-startup-hook'. This hook exists for users to set,
so as to override the definitions made by the terminal-specific file.
Emacs never sets this variable itself.")
(defvar inhibit-startup-hooks nil
"Non-nil means don't run `term-setup-hook' and `emacs-startup-hook'.
This is because we already did so.")
(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.")
(defvar window-setup-hook nil
"Normal hook run to initialize window system display.
Emacs runs this hook after processing the command line arguments and loading
the user's init file.")
(defcustom initial-major-mode 'lisp-interaction-mode
"Major mode command symbol to use for the initial `*scratch*' buffer."
:type 'function
:group 'initialization)
(defvar init-file-user nil
"Identity of user whose `.emacs' 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 `.emacs' 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 (purecopy "site-start")
"File containing site-wide run-time initializations.
This file is loaded at run-time before `~/.emacs'. It contains inits
that need to be in place for the entire site, but which, due to their
higher incidence of change, don't make sense to load into Emacs's
dumped image. Thus, the run-time load order is: 1. file described in
this variable, if non-nil; 2. `~/.emacs'; 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)
:group 'initialization
:initialize 'custom-initialize-default
:set (lambda (_variable _value)
(error "Customizing `site-run-file' does not work")))
(defcustom mail-host-address nil
"Name of this machine, for purposes of naming users.
If non-nil, Emacs uses this instead of `system-name' when constructing
email addresses."
:type '(choice (const nil) string)
:group 'mail)
(defcustom user-mail-address (if command-line-processed
(or (getenv "EMAIL")
(concat (user-login-name) "@"
(or mail-host-address
(system-name))))
;; Empty string means "not set yet".
"")
"Full mailing address of this user.
This is initialized with environment variable `EMAIL' or, as a
fallback, using `mail-host-address'. This is done after your
init file is read, in case it sets `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 `.emacs' 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."
: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)
(defvar default-frame-background-mode)
(defvar pure-space-overflow nil
"Non-nil if building Emacs overflowed pure space.")
(defvar pure-space-overflow-message (purecopy "\
Warning Warning!!! Pure space overflow !!!Warning Warning
\(See the node Pure Storage in the Lisp manual for details.)\n"))
(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)
(defconst package-subdirectory-regexp
"\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)"
"Regular expression matching the name of a package subdirectory.
The first subexpression is the package name.
The second subexpression is the version string.
The regexp should not contain a starting \"\\`\" or a trailing
\"\\'\"; those are added automatically by callers.")
(defun normal-top-level-add-subdirs-to-load-path ()
"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 'untranslated-canonical-name)
(untranslated-canonical-name this-dir))))
;; The Windows version doesn't report meaningful inode numbers, so
;; use the canonicalized absolute file name of the directory instead.
(setq attrs (or canonicalized
(nthcdr 10 (file-attributes this-dir))))
(unless (member attrs normal-top-level-add-subdirs-inode-list)
(push attrs normal-top-level-add-subdirs-inode-list)
(dolist (file contents)
(and (string-match "\\`[[:alnum:]]" file)
;; The lower-case variants of RCS and CVS are for DOS/Windows.
(not (member file '("RCS" "CVS" "rcs" "cvs")))
;; Avoid doing a `stat' when it isn't necessary because
;; that can cause trouble when an NFS server is down.
(not (string-match "\\.elc?\\'" file))
(file-directory-p file)
(let ((expanded (expand-file-name file)))
(or (file-exists-p (expand-file-name ".nosearch" expanded))
(setq pending (nconc pending (list expanded))))))))))
(normal-top-level-add-to-load-path (cdr (nreverse dirs)))))
(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))))))
(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'."
(if command-line-processed
(message "Back to top level.")
(setq command-line-processed t)
(let ((dir default-directory))
(with-current-buffer "*Messages*"
;; Make it easy to do like "tail -f".
(set (make-local-variable 'window-point-insertion-type) t)
;; Give *Messages* the same default-directory as *scratch*,
;; just to keep things predictable.
(setq default-directory dir)))
;; `user-full-name' is now known; reset its standard-value here.
(put 'user-full-name 'standard-value
(list (default-value 'user-full-name)))
;; 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,
;; 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))
;; For out-of-tree builds, leim-list is generated in the build dir.
;;; (leimdir (expand-file-name "../leim" doc-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.
;; http://lists.gnu.org/archive/html/emacs-devel/2009-10/msg00502.html
(or (string-match (concat "\\`" 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))))
;; If the PWD environment variable isn't accurate, delete it.
(let ((pwd (getenv "PWD")))
(and (stringp pwd)
;; Use FOO/., so that if FOO is a symlink, file-attributes
;; describes the directory linked to, not FOO itself.
(or (equal (file-attributes
(concat (file-name-as-directory pwd) "."))
(file-attributes
(concat (file-name-as-directory default-directory)
".")))
(setq process-environment
(delete (concat "PWD=" pwd)
process-environment)))))
(setq default-directory (abbreviate-file-name default-directory))
(let ((old-face-font-rescale-alist face-font-rescale-alist))
(unwind-protect
(command-line)
;; Do this again, in case .emacs defined more abbreviations.
(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)
(and term-setup-hook
(run-hooks '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 te default face's :font
;; attribute here. See bug#1785.
(unless (eq face-font-rescale-alist
old-face-font-rescale-alist)
(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)))
;; time to make the frame visible (Aquamacs)
(unless (and (eq initial-window-system 'ns)
(ns-application-hidden-p))
(if (or show-scratch-buffer-on-startup
(not (equal (buffer-name (current-buffer)) "*scratch*")))
(make-frame-visible))))
;; Now we know the user's default font, so add it to the menu.
(if (fboundp 'font-menu-add-default)
(font-menu-add-default))
(and window-setup-hook
(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")
;; 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))
(dolist (varval initial-environment)
(if (string-match "\\`DISPLAY=" varval)
(setq display varval))))
(when display
(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")))
(defconst tool-bar-images-pixel-height 24
"Height in pixels of images in the tool-bar.")
(defvar tool-bar-originally-present nil
"Non-nil if tool-bars are present before user and site init files are read.")
(defvar handle-args-function-alist '((nil . tty-handle-args))
"Functions for processing window-system dependent command-line arguments.
Window system startup files should add their own function to this
alist, which should parse the command line arguments. Those
pertaining to the window system should be processed and removed
from the returned command line.")
(defvar window-system-initialization-alist '((nil . ignore))
"Alist of window-system initialization functions.
Window-system startup files should add their own initialization
function to this list. The function should take no arguments,
and initialize the window system environment to prepare for
opening the first frame (e.g. open a connection to an X server).")
(defun tty-handle-args (args)
"Handle the X-like command-line arguments \"-fg\", \"-bg\", \"-name\", etc."
(let (rest)
(message "%S" args)
(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 (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)))))
(nreverse rest)))
(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 command-line ()
"A subroutine of `normal-top-level'.
Amongst another things, it parses the command-line arguments."
(setq before-init-time (current-time)
after-init-time nil
command-line-default-directory default-directory)
;; Force recomputation, in case it was computed during the dump.
(setq abbreviated-home-dir nil)
;; See if we should import version-control from the environment variable.
(let ((vc (getenv "VERSION_CONTROL")))
(cond ((eq vc nil)) ;don't do anything if not set
((member vc '("t" "numbered"))
(setq version-control t))
((member vc '("nil" "existing"))
(setq version-control nil))
((member vc '("never" "simple"))
(setq version-control 'never))))
;;! This has been commented out; I currently find the behavior when
;;! split-window-keep-point is nil disturbing, but if I can get used
;;! to it, then it would be better to eliminate the option.
;;! ;; Choose a good default value for split-window-keep-point.
;;! (setq split-window-keep-point (> baud-rate 2400))
;; Set the default strings to display in mode line for
;; end-of-line formats that aren't native to this platform.
(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)")))
(set-locale-environment nil)
;; Convert preloaded file names in load-history to absolute.
(let ((simple-file-name
;; Look for simple.el or simple.elc and use their directory
;; as the place where all Lisp files live.
(locate-file "simple" load-path (get-load-suffixes)))
lisp-dir)
;; Don't abort if simple.el cannot be found, but print a warning.
(if (null simple-file-name)
(progn
(princ "Warning: Could not find simple.el nor simple.elc"
'external-debugging-output)
(terpri 'external-debugging-output))
(setq lisp-dir (file-truename (file-name-directory simple-file-name)))
(setq load-history
(mapcar (lambda (elt)
(if (and (stringp (car elt))
(not (file-name-absolute-p (car elt))))
(cons (concat lisp-dir
(car elt))
(cdr elt))
elt))
load-history))))
;; Convert the arguments to Emacs internal representation.
(let ((args (cdr command-line-args)))
(while args
(setcar args
(decode-coding-string (car args) locale-coding-system t))
(pop args)))
(let ((done nil)
(args (cdr command-line-args))
display-arg)
;; Figure out which user's init file to load,
;; either from the environment or from the options.
(setq init-file-user (if noninteractive nil (user-login-name)))
;; If user has not done su, use current $HOME to find .emacs.
(and init-file-user
(equal init-file-user (user-real-login-name))
(setq init-file-user ""))
;; Process the command-line args, and delete the arguments
;; processed. This is consistent with the way main in emacs.c
;; does things.
(while (and (not done) args)
(let* ((longopts '(("--no-init-file") ("--no-site-file") ("--debug-init")
("--user") ("--iconic") ("--icon-type") ("--quick")
("--no-blinking-cursor") ("--basic-display")))
(argi (pop args))
(orig-argi argi)
argval)
;; Handle --OPTION=VALUE format.
(when (string-match "\\`\\(--[^=]*\\)=" argi)
(setq argval (substring argi (match-end 0))
argi (match-string 1 argi)))
(when (string-match "\\`--." orig-argi)
(let ((completion (try-completion argi longopts)))
(cond ((eq completion t)
(setq argi (substring argi 1)))
((stringp completion)
(let ((elt (assoc completion longopts)))
(unless elt
(error "Option `%s' is ambiguous" argi))
(setq argi (substring (car elt) 1))))
(t
(setq argval nil
argi orig-argi)))))
(cond
;; The --display arg is handled partly in C, partly in Lisp.
;; When it shows up here, we just put it back to be handled
;; by `command-line-1'.
((member argi '("-d" "-display"))
(setq display-arg (list argi (pop args))))
((member argi '("-Q" "-quick"))
(setq init-file-user nil
site-run-file nil
inhibit-x-resources t))
((member argi '("-D" "-basic-display"))
(setq no-blinking-cursor t
emacs-basic-display t)
(push '(vertical-scroll-bars . nil) initial-frame-alist))
((member argi '("-q" "-no-init-file"))
(setq init-file-user nil))
((member argi '("-u" "-user"))
(setq init-file-user (or argval (pop args))
argval nil))
((equal argi "-no-site-file")
(setq site-run-file nil))
((equal argi "-debug-init")
(setq init-file-debug t))
((equal argi "-iconic")
(push '(visibility . icon) initial-frame-alist))
((member argi '("-nbc" "-no-blinking-cursor"))
(setq no-blinking-cursor t))
;; Push the popped arg back on the list of arguments.
(t
(push argi args)
(setq done t)))
;; Was argval set but not used?
(and argval
(error "Option `%s' doesn't allow an argument" argi))))
;; Re-attach the --display arg.
(and display-arg (setq args (append display-arg args)))
;; Re-attach the program name to the front of the arg list.
(and command-line-args
(setcdr command-line-args args)))
;; Make sure window system's init file was loaded in loadup.el if
;; using a window system.
;; Initialize the window-system only after processing the command-line
;; args so that -Q can influence this initialization.
(condition-case error
(unless noninteractive
(if (and initial-window-system
(not (featurep
(intern
(concat (symbol-name initial-window-system) "-win")))))
(error "Unsupported window system `%s'" initial-window-system))
;; Process window-system specific command line parameters.
(setq command-line-args
(funcall
(or (cdr (assq initial-window-system handle-args-function-alist))
(error "Unsupported window system `%s'" initial-window-system))
command-line-args))
;; Initialize the window system. (Open connection, etc.)
(funcall
(or (cdr (assq initial-window-system window-system-initialization-alist))
(error "Unsupported window system `%s'" initial-window-system))))
;; If there was an error, print the error message and exit.
(error
(princ
(if (eq (car error) 'error)
(apply 'concat (cdr error))
(if (memq 'file-error (get (car error) 'error-conditions))
(format "%s: %s"
(nth 1 error)
(mapconcat (lambda (obj) (prin1-to-string obj t))
(cdr (cdr error)) ", "))
(format "%s: %s"
(get (car error) 'error-message)
(mapconcat (lambda (obj) (prin1-to-string obj t))
(cdr error) ", "))))
'external-debugging-output)
(terpri 'external-debugging-output)
(setq initial-window-system nil)
(kill-emacs)))
(run-hooks 'before-init-hook)
(let ((initial-frame-alist (append '((visibility . nil))
initial-frame-alist)))
;; Under X, create the X frame and delete the terminal frame.
(unless (daemonp)
(if (or noninteractive emacs-basic-display)
(setq menu-bar-mode nil
tool-bar-mode nil
no-blinking-cursor t))
(frame-initialize))
;; allow frame-notice-user-settings to override
(setq frame-initial-geometry-arguments
(delete '(visibility . nil) ;
frame-initial-geometry-arguments)))
;; Turn off blinking cursor if so specified in X resources. This is here
;; only because all other settings of no-blinking-cursor are here.
(unless (or noninteractive
emacs-basic-display
(and (memq window-system '(x w32 ns))
(not (member (x-get-resource "cursorBlink" "CursorBlink")
'("no" "off" "false" "0")))))
(setq no-blinking-cursor t))
;; Re-evaluate predefined variables whose initial value depends on
;; the runtime context.
(mapc 'custom-reevaluate-setting
;; Initialize them in the same order they were loaded, in case there
;; are dependencies between them.
(prog1 (nreverse custom-delayed-init-variables)
(setq custom-delayed-init-variables nil)))
;; In Aquamacs, images are loaded when setting up tool-bar
;; which requires image-load-path to be defined, which is a
;; custom variable with delayed initialization.
;; (let ((image-load-path (list (car image-load-path))) ;; speed gain?
;; (tool-bar-load-png-only t)) ;; Aquamacs only (speed gain)
;; (unless (or noninteractive (not (fboundp 'tool-bar-mode)))
;; ;; Set up the tool-bar. Do this even in tty frames, so that there
;; ;; is a tool-bar if Emacs later opens a graphical frame.
;; (if (or emacs-basic-display
;; (and (numberp (frame-parameter nil 'tool-bar-lines))
;; (<= (frame-parameter nil 'tool-bar-lines) 0)))
;; ;; On a graphical display with the toolbar disabled via X
;; ;; resources, set up the toolbar without enabling it.
;; (tool-bar-setup)
;; ;; Otherwise, enable tool-bar-mode.
;; (tool-bar-mode 1))))
;; do this after custom-reevaluate-setting so that image-load-path is available.
(when (fboundp 'x-create-frame)
;; Set up the tool-bar (even in tty frames, since Emacs might open a
;; graphical frame later).
(unless noninteractive
(let (;; (image-load-path (list (car image-load-path))) ;; speed gain?
(tool-bar-load-png-only t)) ;; Aquamacs only (speed gain)
(tool-bar-setup))))
(normal-erase-is-backspace-setup-frame)
;; Register default TTY colors for the case the terminal hasn't a
;; terminal init file. We do this regardless of whether the terminal
;; supports colors or not and regardless the current display type,
;; since users can connect to color-capable terminals and also
;; switch color support on or off in mid-session by setting the
;; tty-color-mode frame parameter.
;; Exception: the `pc' ``window system'' has only 16 fixed colors,
;; and they are already set at this point by a suitable function in
;; window-system-initialization-alist.
(or (eq initial-window-system 'pc)
(tty-register-default-colors))
;; Record whether the tool-bar is present before the user and site
;; init files are processed. frame-notice-user-settings uses this
;; to determine if the tool-bar has been disabled by the init files,
;; and the frame needs to be resized.
(when (fboundp 'frame-notice-user-settings)
(let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist)
(assq 'tool-bar-lines default-frame-alist))))