Annotation of 43BSDReno/contrib/emacs-18.55/lisp/startup.el, revision 1.1.1.1

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))))))))

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.