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