Annotation of 43BSD/contrib/emacs/lisp/startup.el, revision 1.1.1.1

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

unix.superglobalmegacorp.com

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