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