home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / NeXT / GnuSource / emacs-15.0.3 / lisp / startup.el-orig < prev    next >
Lisp/Scheme  |  1990-07-19  |  9KB  |  224 lines
  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 `args'.")
  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.     (unwind-protect
  83.     (command-line)
  84.       (and term-setup-hook
  85.        (funcall term-setup-hook))
  86.       (and window-setup-hook
  87.        (funcall window-setup-hook)))))
  88.  
  89. (defun command-line ()
  90.   (let ((args (cdr command-line-args))
  91.     (init (if noninteractive nil (user-login-name)))
  92.     (done nil))
  93.     ;; If user has not done su, use current $HOME to find .emacs.
  94.     (and init (string= init (user-real-login-name))
  95.      (setq init ""))
  96.     (while (and (not done) args)
  97.       (let ((argi (car args)))
  98.     (if (or (string-equal argi "-q")
  99.         (string-equal argi "-no-init-file"))
  100.         (setq init nil
  101.           args (cdr args))
  102.       (if (or (string-equal argi "-u")
  103.           (string-equal argi "-user"))
  104.           (setq args (cdr args)
  105.             init (car args)
  106.             args (cdr args))
  107.         (setq done t)))))
  108.     ;; Load user's init file, or load default one.
  109.     (if init
  110.     (progn (load (if (eq system-type 'vax-vms)
  111.              "sys$login:.emacs"
  112.                (concat "~" init "/.emacs"))
  113.              t t t)
  114.            (or inhibit-default-init
  115.            (let ((inhibit-startup-message nil))
  116.              ;; Users are supposed to be told their rights.
  117.              ;; (Plus how to get help and how to undo.)
  118.              ;; Don't you dare turn this off for anyone
  119.              ;; except yourself.
  120.              (load "default" t t)))))
  121.     (if (get-buffer "*scratch*")
  122.     (save-excursion
  123.       (set-buffer "*scratch*")
  124.       (funcall initial-major-mode)))
  125.     ;; Load library for our terminal type.
  126.     ;; User init file can set term-file-prefix to nil to prevent this.
  127.     (and term-file-prefix (not noninteractive)
  128.      (if window-system
  129.          (load (concat term-file-prefix
  130.                (symbol-name window-system)
  131.                "-win")
  132.            t t)
  133.        (let ((term (getenv "TERM"))
  134.          hyphend)
  135.          (while (and term
  136.              (not (load (concat term-file-prefix term) t t)))
  137.            ;; Strip off last hyphen and what follows, then try again
  138.            (if (setq hyphend (string-match "[-_][^-_]+$" term))
  139.            (setq term (substring term 0 hyphend))
  140.          (setq term nil))))))
  141.     (command-line-1 args)
  142.     (if noninteractive (kill-emacs t))))
  143.  
  144. (defun command-line-1 (command-line-args-left)
  145.   (if (null command-line-args-left)
  146.       (cond ((and (not inhibit-startup-message) (not noninteractive)
  147.           ;; Don't clobber a non-scratch buffer if init file
  148.           ;; has selected it.
  149.           (string= (buffer-name) "*scratch*")
  150.           (not (input-pending-p)))
  151.          ;; If there are no switches to procss, we might as well
  152.          ;; run this hook now, and there may be some need to do it
  153.          ;; before doing any output.
  154.          (and term-setup-hook
  155.           (funcall term-setup-hook))
  156.          ;; Don't let the hook be run twice.
  157.          (setq term-setup-hook nil)
  158.          (and window-setup-hook
  159.           (funcall window-setup-hook))
  160.          (setq window-setup-hook nil)
  161.          (unwind-protect
  162.          (progn
  163.            (insert (emacs-version)
  164.                "
  165. Copyright (C) 1988 Free Software Foundation, Inc.\n")
  166.            ;; If keys have their default meanings,
  167.            ;; use precomputed string to save lots of time.
  168.            (if (and (eq (key-binding "\C-h") 'help-command)
  169.                 (eq (key-binding "\C-xu") 'advertised-undo)
  170.                 (eq (key-binding "\C-h\C-c") 'describe-copying)
  171.                 (eq (key-binding "\C-h\C-d") 'describe-distribution)
  172.                 (eq (key-binding "\C-h\C-w") 'describe-no-warranty)
  173.                 (eq (key-binding "\C-ht") 'help-with-tutorial))
  174.                (insert 
  175.        "Type C-h for help; C-x u to undo changes.  (`C-' means use CTRL key.)
  176.  
  177. GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details.
  178. You may give out copies of Emacs; type C-h C-c to see the conditions.
  179. Type C-h C-d for information on getting the latest version.
  180. Type C-h t for a tutorial on using Emacs.")
  181.              (insert (substitute-command-keys
  182.        "Type \\[help-command] for help; \\[advertised-undo] to undo changes.  (`C-' means use CTRL key.)
  183.  
  184. GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details.
  185. You may give out copies of Emacs; type \\[describe-copying] to see the conditions.
  186. Type \\[describe-distribution] for information on getting the latest version.
  187. Type \\[help-with-tutorial] for a tutorial on using Emacs.")))
  188.            (set-buffer-modified-p nil)
  189.            (sit-for 120))
  190.          (erase-buffer)
  191.          (set-buffer-modified-p nil))))
  192.     (let ((dir default-directory)
  193.       (line 0))
  194.       (while command-line-args-left
  195.     (let ((argi (car command-line-args-left))
  196.           tem)
  197.       (setq command-line-args-left (cdr command-line-args-left))
  198.       (cond ((setq tem (assoc argi command-switch-alist))
  199.          (funcall (cdr tem) argi))
  200.         ((or (string-equal argi "-f")  ;what the manual claims
  201.              (string-equal argi "-funcall")
  202.              (string-equal argi "-e")) ; what the source used to say
  203.          (setq tem (intern (car command-line-args-left)))
  204.          (setq command-line-args-left (cdr command-line-args-left))
  205.          (funcall tem))
  206.         ((or (string-equal argi "-l")
  207.              (string-equal argi "-load"))
  208.          (let ((load-path (cons default-directory load-path)))
  209.            (load (car command-line-args-left) nil t))
  210.          (setq command-line-args-left (cdr command-line-args-left)))
  211.         ((or (string-equal argi "-i")
  212.              (string-equal argi "-insert"))
  213.          (insert-file-contents (car command-line-args-left))
  214.          (setq command-line-args-left (cdr command-line-args-left)))
  215.         ((string-equal argi "-kill")
  216.          (kill-emacs t))
  217.         ((string-match "^\\+[0-9]+\\'" argi)
  218.          (setq line (string-to-int argi)))
  219.         (t
  220.          (find-file (expand-file-name argi dir))
  221.          (or (zerop line)
  222.              (goto-line line))
  223.          (setq line 0))))))))
  224.