|
|
1.1 root 1: ;; Process Emacs shell arguments
2: ;; Copyright (C) 1985 Richard M. Stallman.
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: ; -q load no init file
32: ; -u user load user's init file
33:
34: ; These are processed in the order encountered.
35: ; -f function execute function
36: ; -l file load file
37: ; file visit file
38: ; -kill kill (exit) emacs
39:
40: (setq top-level '(normal-top-level))
41:
42: (defconst inhibit-command-line nil
43: "*Non-nil inhibits usual processing of command line args from shell.
44: Exception: -batch, -q and -u are processed normally anyway.")
45:
46: (defvar command-line-processed nil "t once command line has been processed")
47:
48: (defconst inhibit-startup-message nil
49: "*Non-nil inhibits the initial startup messages")
50:
51: (defconst command-switch-alist nil
52: "Alist of command-line switches.
53: Elements look like (SWITCH-STRING . HANDLER-FUNCTION).
54: HANDLER-FUNCTION receives switch name as sole arg;
55: remaining command-line args are in the variable `args'.")
56:
57: (defvar term-setup-hook nil)
58:
59: (defun normal-top-level ()
60: (if command-line-processed
61: (message "Back to top level.")
62: (setq command-line-processed t)
63: (unwind-protect
64: (command-line)
65: (and term-setup-hook
66: (funcall term-setup-hook)))))
67:
68: (defun command-line ()
69: (let ((args (cdr command-line-args))
70: (user (if noninteractive
71: nil
72: (or (getenv "USER")
73: (getenv "LOGNAME")))) ;USG bletcherousness.
74: done)
75: (while (and (not done) args)
76: (let ((argi (car args)))
77: (if (string-equal argi "-q")
78: (setq user nil
79: args (cdr args))
80: (if (string-equal argi "-u")
81: (setq args (cdr args)
82: user (car args)
83: args (cdr args))
84: (setq done t)))))
85: ;; Load user's init file, or load default one.
86: (condition-case error
87: (if user
88: (or (load (concat "~" user "/.emacs") t t)
89: ;;>> need a good, < 11 character name for this,
90: ;;>> preferably involving the string "init"
91: ;;>> ("defaultinit" almost works)
92: ;;>> The 11 chars is to allow ".elc" and inferior unix versions
93: (load "default-profile" t t)))
94: (error (message "Error in init file")))
95: (setq mode-line-format default-mode-line-format
96: case-fold-search default-case-fold-search
97: fill-column default-fill-column
98: abbrev-mode default-abbrev-mode
99: ctl-arrow default-ctl-arrow
100: left-margin default-left-margin
101: tab-width default-tab-width
102: truncate-lines default-truncate-lines)
103: ;; Load library for our terminal type.
104: ;; User init file can set term-file-prefix to nil to prevent this.
105: (and term-file-prefix (not noninteractive)
106: (load (concat term-file-prefix (getenv "TERM")) t t))
107: (and (eq major-mode 'lisp-interaction-mode)
108: (run-hooks 'lisp-interaction-mode-hook))
109: ;; init file sets inhibit-command-line to prevent normal processing.
110: (if (not inhibit-command-line)
111: (command-line-1 args))))
112:
113: (defun command-line-1 (command-line-args)
114: (if (null command-line-args)
115: (cond ((and (not inhibit-startup-message) (not noninteractive)
116: (not (input-pending-p)))
117: ;; If there are no switches to procss, we might as well
118: ;; run this hook now, and there may be some need to do it
119: ;; before doing any output.
120: (and term-setup-hook
121: (funcall term-setup-hook))
122: ;; Don't let the hook be run twice.
123: (setq term-setup-hook nil)
124: (unwind-protect
125: (progn
126: (insert (emacs-version)
127: "
128: Copyright (C) 1985 Richard Stallman/Free Software Foundation, Inc\n")
129: ;; If keys have their default meanings,
130: ;; use precomputed string to save lots of time.
131: (if (and (eq (key-binding "\C-h") 'help-command)
132: (eq (key-binding "\C-xu") 'advertised-undo)
133: (eq (key-binding "\C-h\C-c") 'describe-copying)
134: (eq (key-binding "\C-h\C-d") 'describe-distribution)
135: (eq (key-binding "\C-h\C-w") 'describe-no-warranty)
136: (eq (key-binding "\C-ht") 'help-with-tutorial))
137: (insert
138: "Type C-h for help; C-x u to undo changes. (`C-' means use CTRL key.)
139:
140: GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details.
141: You may give out copies of Emacs; type C-h C-c to see the conditions.
142: Type C-h C-d for information on getting the latest version.
143: Type C-h t for a tutorial on using Emacs.")
144: (insert (substitute-command-keys
145: "Type \\[help-command] for help; \\[advertised-undo] to undo changes. (`C-' means use CTRL key.)
146:
147: GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details.
148: You may give out copies of Emacs; type \\[describe-copying] to see the conditions.
149: Type \\[describe-distribution] for information on getting the latest version.
150: Type \\[help-with-tutorial] for a tutorial on using Emacs.")))
151: (set-buffer-modified-p nil)
152: (sit-for 120))
153: (erase-buffer)
154: (set-buffer-modified-p nil))))
155: (let ((dir default-directory)
156: (line 0))
157: (while command-line-args
158: (let ((argi (car command-line-args))
159: tem)
160: (setq command-line-args (cdr command-line-args))
161: (cond ((setq tem (assoc argi command-switch-alist))
162: (funcall (cdr tem) argi))
163: ((or (string-equal argi "-f") ;what the manual claims
164: (string-equal argi "-e")) ; what the source used to say
165: (setq tem (intern (car command-line-args)))
166: (setq command-line-args (cdr command-line-args))
167: (funcall tem))
168: ((string-equal argi "-l")
169: (load (car command-line-args) nil t)
170: (setq command-line-args (cdr command-line-args)))
171: ((string-equal argi "-kill")
172: (kill-emacs t))
173: ((string-match "^\\+[0-9]+\\'" argi)
174: (setq line (string-to-int argi)))
175: (t
176: (find-file (expand-file-name argi dir))
177: (goto-line line)
178: (setq line 0))))))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.