|
|
1.1 root 1: ;; Process Emacs shell arguments
2: ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
3:
4: ;; This file is part of GNU Emacs.
5:
6: ;; GNU Emacs is distributed in the hope that it will be useful,
7: ;; but WITHOUT ANY WARRANTY. No author or distributor
8: ;; accepts responsibility to anyone for the consequences of using it
9: ;; or for whether it serves any particular purpose or works at all,
10: ;; unless he says so in writing. Refer to the GNU Emacs General Public
11: ;; License for full details.
12:
13: ;; Everyone is granted permission to copy, modify and redistribute
14: ;; GNU Emacs, but only under the conditions described in the
15: ;; GNU Emacs General Public License. A copy of this license is
16: ;; supposed to have been given to you along with GNU Emacs so you
17: ;; can know your rights and responsibilities. It should be in a
18: ;; file named COPYING. Among other things, the copyright notice
19: ;; and this notice must be preserved on all copies.
20:
21:
22: ; These are processed only at the beginning of the argument list.
23: ; -batch execute noninteractively (messages go to stdout,
24: ; variable noninteractive set to t)
25: ; This option must be the first in the arglist.
26: ; Processed by `main' in emacs.c -- never seen by lisp
27: ; -t file Specify to use file rather than stdin/stdout
28: ; as the terminal.
29: ; This option must be the first in the arglist.
30: ; Processed by `main' in emacs.c -- never seen by lisp
31: ; -nw Inhibit the use of any window-system-specific display
32: ; code; use the current virtual terminal.
33: ; This option must be the first in the arglist.
34: ; Processed by `main' in emacs.c -- never seen by lisp
35: ; -q load no init file
36: ; -no-init-file same
37: ; -u user load user's init file
38: ; -user user same
39:
40: ; These are processed in the order encountered.
41: ; -f function execute function
42: ; -funcall function same
43: ; -l file load file
44: ; -load file same
45: ; -i file insert file into buffer
46: ; -insert file same
47: ; file visit file
48: ; -kill kill (exit) emacs
49:
50: (setq top-level '(normal-top-level))
51:
52: (defvar command-line-processed nil "t once command line has been processed")
53:
54: (defconst inhibit-startup-message nil
55: "*Non-nil inhibits the initial startup messages.
56: This is for use in your personal init file, once you are familiar
57: with the contents of the startup message.")
58:
59: (defconst inhibit-default-init nil
60: "*Non-nil inhibits loading the `default' library.")
61:
62: (defconst command-switch-alist nil
63: "Alist of command-line switches.
64: Elements look like (SWITCH-STRING . HANDLER-FUNCTION).
65: HANDLER-FUNCTION receives switch name as sole arg;
66: remaining command-line args are in the variable `command-line-args-left'.")
67:
68: (defvar term-setup-hook nil
69: "Function to be called after loading terminal-specific lisp code.
70: It is called with no arguments. You can use this to override the
71: definitions made by the terminal-specific file.")
72:
73: (defvar window-setup-hook nil)
74:
75: (defconst initial-major-mode 'lisp-interaction-mode
76: "Major mode command symbol to use for the initial *scratch* buffer.")
77:
78: (defun normal-top-level ()
79: (if command-line-processed
80: (message "Back to top level.")
81: (setq command-line-processed t)
82: ;; In presence of symlinks, switch to cleaner form of default directory.
83: (if (getenv "PWD")
84: (setq default-directory (file-name-as-directory (getenv "PWD"))))
85: (unwind-protect
86: (command-line)
87: (and term-setup-hook
88: (funcall term-setup-hook))
89: (and window-setup-hook
90: (funcall window-setup-hook)))))
91:
92: (defun command-line ()
93: (let ((args (cdr command-line-args))
94: (init (if noninteractive nil (user-login-name)))
95: (done nil))
96: ;; If user has not done su, use current $HOME to find .emacs.
97: (and init (string= init (user-real-login-name))
98: (setq init ""))
99: (while (and (not done) args)
100: (let ((argi (car args)))
101: (if (or (string-equal argi "-q")
102: (string-equal argi "-no-init-file"))
103: (setq init nil
104: args (cdr args))
105: (if (or (string-equal argi "-u")
106: (string-equal argi "-user"))
107: (setq args (cdr args)
108: init (car args)
109: args (cdr args))
110: (setq done t)))))
111: ;; Load user's init file, or load default one.
112: (condition-case error
113: (if init
114: (progn (load (if (eq system-type 'vax-vms)
115: "sys$login:.emacs"
116: (concat "~" init "/.emacs"))
117: t t t)
118: (or inhibit-default-init
119: (let ((inhibit-startup-message nil))
120: ;; Users are supposed to be told their rights.
121: ;; (Plus how to get help and how to undo.)
122: ;; Don't you dare turn this off for anyone
123: ;; except yourself.
124: (load "default" t t)))))
125: (error (message "Error in init file")))
126: (if (get-buffer "*scratch*")
127: (save-excursion
128: (set-buffer "*scratch*")
129: (funcall initial-major-mode)))
130: ;; Load library for our terminal type.
131: ;; User init file can set term-file-prefix to nil to prevent this.
132: (and term-file-prefix (not noninteractive)
133: (if window-system
134: (load (concat term-file-prefix
135: (symbol-name window-system)
136: "-win")
137: t t)
138: (let ((term (getenv "TERM"))
139: hyphend)
140: (while (and term
141: (not (load (concat term-file-prefix term) t t)))
142: ;; Strip off last hyphen and what follows, then try again
143: (if (setq hyphend (string-match "[-_][^-_]+$" term))
144: (setq term (substring term 0 hyphend))
145: (setq term nil))))))
146: (command-line-1 args)
147: (if noninteractive (kill-emacs t))))
148:
149: (defun command-line-1 (command-line-args-left)
150: (if (null command-line-args-left)
151: (cond ((and (not inhibit-startup-message) (not noninteractive)
152: ;; Don't clobber a non-scratch buffer if init file
153: ;; has selected it.
154: (string= (buffer-name) "*scratch*")
155: (not (input-pending-p)))
156: ;; If there are no switches to procss, we might as well
157: ;; run this hook now, and there may be some need to do it
158: ;; before doing any output.
159: (and term-setup-hook
160: (funcall term-setup-hook))
161: ;; Don't let the hook be run twice.
162: (setq term-setup-hook nil)
163: (and window-setup-hook
164: (funcall window-setup-hook))
165: (setq window-setup-hook nil)
166: (unwind-protect
167: (progn
168: (insert (emacs-version)
169: "
170: Copyright (C) 1988 Free Software Foundation, Inc.\n")
171: ;; If keys have their default meanings,
172: ;; use precomputed string to save lots of time.
173: (if (and (eq (key-binding "\C-h") 'help-command)
174: (eq (key-binding "\C-xu") 'advertised-undo)
175: (eq (key-binding "\C-h\C-c") 'describe-copying)
176: (eq (key-binding "\C-h\C-d") 'describe-distribution)
177: (eq (key-binding "\C-h\C-w") 'describe-no-warranty)
178: (eq (key-binding "\C-ht") 'help-with-tutorial))
179: (insert
180: "Type C-h for help; C-x u to undo changes. (`C-' means use CTRL key.)
181:
182: GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details.
183: You may give out copies of Emacs; type C-h C-c to see the conditions.
184: Type C-h C-d for information on getting the latest version.
185: Type C-h t for a tutorial on using Emacs.")
186: (insert (substitute-command-keys
187: "Type \\[help-command] for help; \\[advertised-undo] to undo changes. (`C-' means use CTRL key.)
188:
189: GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details.
190: You may give out copies of Emacs; type \\[describe-copying] to see the conditions.
191: Type \\[describe-distribution] for information on getting the latest version.
192: Type \\[help-with-tutorial] for a tutorial on using Emacs.")))
193: (set-buffer-modified-p nil)
194: (sit-for 120))
195: (erase-buffer)
196: (set-buffer-modified-p nil))))
197: (let ((dir default-directory)
198: (line 0))
199: (while command-line-args-left
200: (let ((argi (car command-line-args-left))
201: tem)
202: (setq command-line-args-left (cdr command-line-args-left))
203: (cond ((setq tem (assoc argi command-switch-alist))
204: (funcall (cdr tem) argi))
205: ((or (string-equal argi "-f") ;what the manual claims
206: (string-equal argi "-funcall")
207: (string-equal argi "-e")) ; what the source used to say
208: (setq tem (intern (car command-line-args-left)))
209: (setq command-line-args-left (cdr command-line-args-left))
210: (funcall tem))
211: ((or (string-equal argi "-l")
212: (string-equal argi "-load"))
213: (let ((load-path (cons default-directory load-path)))
214: (load (car command-line-args-left) nil t))
215: (setq command-line-args-left (cdr command-line-args-left)))
216: ((or (string-equal argi "-i")
217: (string-equal argi "-insert"))
218: (insert-file-contents (car command-line-args-left))
219: (setq command-line-args-left (cdr command-line-args-left)))
220: ((string-equal argi "-kill")
221: (kill-emacs t))
222: ((string-match "^\\+[0-9]+\\'" argi)
223: (setq line (string-to-int argi)))
224: (t
225: (find-file (expand-file-name argi dir))
226: (or (zerop line)
227: (goto-line line))
228: (setq line 0))))))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.