Annotation of GNUtools/emacs/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 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))))))))

unix.superglobalmegacorp.com

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