X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/cf91c6c8100df1169a6d6f88df5993848e015ce5..332ad7ce48d611a232ddd085331b1069637d85a1:/lisp/startup.el

diff --git a/lisp/startup.el b/lisp/startup.el
index 0bfcf5ecf1..081b3aed12 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1,6 +1,9 @@
 ;;; startup.el --- process Emacs shell arguments
 
-;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1992, 1994 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+;; Keywords: internal
 
 ;; This file is part of GNU Emacs.
 
@@ -18,6 +21,7 @@
 ;; along with GNU Emacs; see the file COPYING.  If not, write to
 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
+;;; Commentary:
 
 ; These are processed only at the beginning of the argument list.
 ; -batch		execute noninteractively (messages go to stdout,
@@ -37,26 +41,38 @@
 ; -u user		load user's init file
 ; -user user		same
 ; -debug-init		Don't catch errors in init file; let debugger run.
+; -no-site-file		Don't load site-run-file.
 
 ; These are processed in the order encountered.
 ; -f function		execute function
 ; -funcall function	same
 ; -l file		load file
 ; -load file		same
-; -i file		insert file into buffer
-; -insert file		same
+; -insert file		insert file into buffer
 ; file			visit file
 ; -kill			kill (exit) emacs
 
+;;; Code:
+
 (setq top-level '(normal-top-level))
 
 (defvar command-line-processed nil "t once command line has been processed")
 
 (defconst inhibit-startup-message nil
-  "*Non-nil inhibits the initial startup messages.
+  "*Non-nil inhibits the initial startup message.
 This is for use in your personal init file, once you are familiar
 with the contents of the startup message.")
 
+(defconst inhibit-startup-echo-area-message nil
+  "*Non-nil inhibits the initial startup echo area message.
+Inhibition takes effect only if your `.emacs' file contains
+a line of this form:
+ (setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\")
+If your `.emacs' file is byte-compiled, use the following form instead:
+ (eval '(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\"))
+Thus, someone else using a copy of your `.emacs' file will see
+the startup message unless he personally acts to inhibit it.")
+
 (defconst inhibit-default-init nil
   "*Non-nil inhibits loading the `default' library.")
 
@@ -66,83 +82,158 @@ Elements look like (SWITCH-STRING . HANDLER-FUNCTION).
 HANDLER-FUNCTION receives switch name as sole arg;
 remaining command-line args are in the variable `command-line-args-left'.")
 
+(defvar command-line-args-left nil
+  "List of command-line args not yet processed.")
+
 (defvar command-line-functions nil    ;; lrs 7/31/89
   "List of functions to process unrecognized command-line arguments.
 Each function should access the dynamically bound variables
-argi (the current argument) and command-line-args-left (the remaining
+`argi' (the current argument) and `command-line-args-left' (the remaining
 arguments).  The function should return non-nil only if it recognizes and
-processes argi.  If it does so, it may consume successive arguments by
-altering command-line-args-left to remove them.")
+processes `argi'.  If it does so, it may consume successive arguments by
+altering `command-line-args-left' to remove them.")
+
+(defvar command-line-default-directory nil
+  "Default directory to use for command line arguments.
+This is normally copied from `default-directory' when Emacs starts.")
 
 (defvar before-init-hook nil
-  "Functions to call after handling urgent options but before loading init file.
-The screen system uses this to open screens to display messages while
+  "Functions to call after handling urgent options but before init files.
+The frame system uses this to open frames to display messages while
 Emacs loads the user's initialization file.")
 
 (defvar after-init-hook nil
-  "Functions to call after loading the init file (~/.emacs).
+  "Functions to call after loading the init file (`~/.emacs').
 The call is not protected by a condition-case, so you can set `debug-on-error'
-in .emacs, and put all the actual code on `after-init-hook'.")
+in `.emacs', and put all the actual code on `after-init-hook'.")
 
 (defvar term-setup-hook nil
-  "Functions to be called after loading terminal-specific lisp code.
+  "Functions to be called after loading terminal-specific Lisp code.
 See `run-hooks'.  This variable exists for users to set,
 so as to override the definitions made by the terminal-specific file.
 Emacs never sets this variable itself.")
 
 (defvar keyboard-type nil
-  "The brand of keyboard you are using.  This variable is used to define
+  "The brand of keyboard you are using.
+This variable is used to define
 the proper function and keypad keys for use under X.  It is used in a
 fashion analogous to the environment value TERM.")
 
 (defvar window-setup-hook nil
-  "Function called to initialize window system display.
-Emacs calls this after processing the command line arguments and loading
-the user's init file.
-
-Users should not set this variable; use term-setup-hook instead.")
+  "Normal hook run to initialize window system display.
+Emacs runs this hook after processing the command line arguments and loading
+the user's init file.")
 
 (defconst initial-major-mode 'lisp-interaction-mode
   "Major mode command symbol to use for the initial *scratch* buffer.")
 
 (defvar init-file-user nil
   "Identity of user whose `.emacs' file is or was read.
-The value may be the null string or a string containing a user's name.
-If the value is a null string, it means that the init file was taken from
-the user that originally logged in.
+The value is nil if no init file is being used; otherwise, it may be either
+the null string, meaning that the init file was taken from the user that
+originally logged in, or it may be a string containing a user's name.
+
+In either of the latter cases, `(concat \"~\" init-file-user \"/\")'
+evaluates to the name of the directory where the `.emacs' file was
+looked for.")
+
+(defvar site-run-file "site-start"
+  "File containing site-wide run-time initializations.
+This file is loaded at run-time before `~/.emacs'.  It contains inits
+that need to be in place for the entire site, but which, due to their
+higher incidence of change, don't make sense to load into emacs'
+dumped image.  Thus, the run-time load order is: 1. file described in
+this variable, if non-nil; 2. `~/.emacs'; 3. `default.el'.")
+
+(defconst iso-8859-1-locale-regexp "8859[-_]?1"
+  "Regexp that specifies when to enable the ISO 8859-1 character set.
+We do that if this regexp matches the locale name
+specified by the LC_ALL, LC_CTYPE and LANG environment variables.")
+
+(defvar mail-host-address nil
+  "*Name of this machine, for purposes of naming users.")
 
-In all cases, `(concat \"~\" init-file-user \"/\")' evaluates to the
-directory name of the directory where the `.emacs' file was looked for.")
+(defvar user-mail-address nil
+  "*Full mailing address of this user.")
 
 (defvar init-file-debug nil)
 
+(defvar init-file-had-error nil)
+
+;; This function is called from the subdirs.el file.
+(defun normal-top-level-add-to-load-path (dirs)
+  (let ((tail (member default-directory load-path)))
+    (setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail)))))
+
 (defun normal-top-level ()
   (if command-line-processed
       (message "Back to top level.")
     (setq command-line-processed t)
-    ;; In presence of symlinks, switch to cleaner form of default directory.
+    ;; Look in each dir in load-path for a subdirs.el file.
+    ;; If we find one, load it, which will add the appropriate subdirs
+    ;; of that dir into load-path,
+    (let ((tail load-path)
+	  new)
+      (while tail
+	(setq new (cons (car tail) new))
+	(let ((default-directory (car tail)))
+	  (load (expand-file-name "subdirs.el" (car tail)) t t t))
+	(setq tail (cdr tail))))
     (if (not (eq system-type 'vax-vms))
-	(mapcar (function
-		 (lambda (var)
-		   (let ((value (getenv var)))
-		     (if (and value
-			      (< (length value) (length default-directory))
-			      (equal (file-attributes default-directory)
-				     (file-attributes value)))
-			 (setq default-directory
-			       (file-name-as-directory value))))))
-		'("PWD" "HOME")))
+	(progn
+	  ;; If the PWD environment variable isn't accurate, delete it.
+	  (let ((pwd (getenv "PWD")))
+	    (and (stringp pwd)
+		 ;; Use FOO/., so that if FOO is a symlink, file-attributes
+		 ;; describes the directory linked to, not FOO itself.
+		 (or (equal (file-attributes
+			     (concat (file-name-as-directory pwd) "."))
+			    (file-attributes
+			     (concat (file-name-as-directory default-directory)
+				     ".")))
+		     (setq process-environment
+			   (delete (concat "PWD=" pwd)
+				   process-environment)))))))
     (setq default-directory (abbreviate-file-name default-directory))
-    (unwind-protect
-	(command-line)
-      (run-hooks 'emacs-startup-hook)
-      (and term-setup-hook
-	   (run-hooks 'term-setup-hook))
-      (and window-setup-hook
-	   (run-hooks 'window-setup-hook)))))
+    (setq user-mail-address (concat (user-login-name) "@"
+				    (or mail-host-address
+					(system-name))))
+    (let ((menubar-bindings-done nil))
+      (unwind-protect
+	  (command-line)
+	;; Do this again, in case .emacs defined more abbreviations.
+	(setq default-directory (abbreviate-file-name default-directory))
+	(run-hooks 'emacs-startup-hook)
+	(and term-setup-hook
+	     (run-hooks 'term-setup-hook))
+	;; Modify the initial frame based on what .emacs puts into
+	;; ...-frame-alist.
+	(if (fboundp 'frame-notice-user-settings)
+	    (frame-notice-user-settings))
+	;; Now we know the user's default font, so add it to the menu.
+	(if (fboundp 'font-menu-add-default)
+	    (font-menu-add-default))
+	(and window-setup-hook
+	     (run-hooks 'window-setup-hook))
+	(or menubar-bindings-done
+	    (precompute-menubar-bindings))))))
+
+;; Precompute the keyboard equivalents in the menu bar items.
+(defun precompute-menubar-bindings ()
+  (if (eq window-system 'x)
+      (let ((submap (lookup-key global-map [menu-bar])))
+	(while submap
+	  (and (consp (car submap))
+	       (symbolp (car (car submap)))
+	       (stringp (car-safe (cdr (car submap))))
+	       (keymapp (cdr (cdr (car submap))))
+	       (x-popup-menu nil (cdr (cdr (car submap)))))
+	  (setq submap (cdr submap))))))
 
 (defun command-line ()
-  ;; See if we should import version-control from the envionment variable.
+  (setq command-line-default-directory default-directory)
+
+  ;; See if we should import version-control from the environment variable.
   (let ((vc (getenv "VERSION_CONTROL")))
     (cond ((eq vc nil))			;don't do anything if not set
 	  ((or (string= vc "t")
@@ -155,17 +246,53 @@ directory name of the directory where the `.emacs' file was looked for.")
 	       (string= vc "simple"))
 	   (setq version-control 'never))))
 
-  ;; Choose a good default value for split-window-keep-point.
-  (setq split-window-keep-point (> baud-rate 2400))
+  (if (let ((ctype
+	     ;; Use the first of these three envvars that has a nonempty value.
+	     (or (let ((string (getenv "LC_ALL")))
+		   (and (not (equal string "")) string))
+		 (let ((string (getenv "LC_CTYPE")))
+		   (and (not (equal string "")) string))
+		 (let ((string (getenv "LANG")))
+		   (and (not (equal string "")) string)))))
+	(and ctype
+	     (string-match iso-8859-1-locale-regexp ctype)))
+      (progn 
+	(require 'disp-table)
+	(standard-display-european t)
+	(require 'iso-syntax)))
+
+  ;;! This has been commented out; I currently find the behavior when
+  ;;! split-window-keep-point is nil disturbing, but if I can get used
+  ;;! to it, then it would be better to eliminate the option.
+  ;;! ;; Choose a good default value for split-window-keep-point.
+  ;;! (setq split-window-keep-point (> baud-rate 2400))
 
   ;; Read window system's init file if using a window system.
-  (if (and window-system (not noninteractive))
-      (load (concat term-file-prefix
-		    (symbol-name window-system)
-		    "-win")
-	    ;; Every window system should have a startup file;
-	    ;; barf if we can't find it.
-	    nil t))
+  (condition-case error
+      (if (and window-system (not noninteractive))
+	  (load (concat term-file-prefix
+			(symbol-name window-system)
+			"-win")
+		;; Every window system should have a startup file;
+		;; barf if we can't find it.
+		nil t))
+    ;; If we can't read it, print the error message and exit.
+    (error
+     (princ
+      (if (eq (car error) 'error)
+	  (apply 'concat (cdr error))
+	(if (memq 'file-error (get (car error) 'error-conditions))
+	    (format "%s: %s"
+		     (nth 1 error)
+		     (mapconcat '(lambda (obj) (prin1-to-string obj t))
+				(cdr (cdr error)) ", "))
+	  (format "%s: %s"
+		   (get (car error) 'error-message)
+		   (mapconcat '(lambda (obj) (prin1-to-string obj t))
+			      (cdr error) ", "))))
+      'external-debugging-output)
+     (setq window-system nil)
+     (kill-emacs)))
 
   (let ((done nil)
 	(args (cdr command-line-args)))
@@ -181,7 +308,21 @@ directory name of the directory where the `.emacs' file was looked for.")
     ;; processed.  This is consistent with the way main in emacs.c
     ;; does things.
     (while (and (not done) args)
-      (let ((argi (car args)))
+      (let ((longopts '(("--no-init-file") ("--no-site-file") ("--user")
+			("--debug-init")))
+	    (argi (car args))
+	    (argval nil))
+	(if (string-match "=" argi)
+	    (setq argval (substring argi (match-end 0))
+		  argi (substring argi 0 (match-beginning 0))))
+	(let ((completion (try-completion argi longopts)))
+	  (if (eq completion t)
+	      (setq argi (substring argi 1))
+	    (if (stringp completion)
+		(let ((elt (assoc completion longopts)))
+		  (or elt
+		      (error "Option `%s' is ambiguous" argi))
+		  (setq argi (substring (car elt) 1))))))
 	(cond
 	 ((or (string-equal argi "-q")
 	      (string-equal argi "-no-init-file"))
@@ -189,46 +330,95 @@ directory name of the directory where the `.emacs' file was looked for.")
 		args (cdr args)))
 	 ((or (string-equal argi "-u")
 	      (string-equal argi "-user"))
-	  (setq args (cdr args)
-		init-file-user (car args)
+	  (or argval
+	      (setq argval (car args)
+		    args (cdr args)))
+	  (setq init-file-user argval
+		argval nil
+		args (cdr args)))
+	 ((string-equal argi "-no-site-file")
+	  (setq site-run-file nil
 		args (cdr args)))
 	 ((string-equal argi "-debug-init")
 	  (setq init-file-debug t
 		args (cdr args)))
-	 (t (setq done t)))))
-    
+	 (t (setq done t)))
+	;; Was argval set but not used?
+	(and argval
+	     (error "Option `%s' doesn't allow an argument" argi))))
+
     ;; Re-attach the program name to the front of the arg list.
     (setcdr command-line-args args))
 
+  ;; Under X Windows, this creates the X frame and deletes the terminal frame.
+  (if (fboundp 'face-initialize)
+      (face-initialize))
+  (if (fboundp 'frame-initialize)
+      (frame-initialize))
+  ;; If frame was created with a menu bar, set menu-bar-mode on.
+  (if (and (eq window-system 'x)
+	   (> (cdr (assq 'menu-bar-lines (frame-parameters))) 0))
+      (menu-bar-mode t))
+
   (run-hooks 'before-init-hook)
 
+  ;; Run the site-start library if it exists.  The point of this file is
+  ;; that it is run before .emacs.  There is no point in doing this after
+  ;; .emacs; that is useless.
+  (if site-run-file 
+      (load site-run-file t t))
+
+  ;; Sites should not disable this.  Only individuals should disable
+  ;; the startup message.
+  (setq inhibit-startup-message nil)
+
   ;; Load that user's init file, or the default one, or none.
-  (let ((debug-on-error init-file-debug)
-	;; This function actually reads the init files.
-	(inner
-	 (function
-	  (lambda ()
-	    (if init-file-user
-		(progn (load (if (eq system-type 'vax-vms)
-				 "sys$login:.emacs"
-			       (concat "~" init-file-user "/.emacs"))
-			     t t t)
-		       (or inhibit-default-init
-			   (let ((inhibit-startup-message nil))
-			     ;; Users are supposed to be told their rights.
-			     ;; (Plus how to get help and how to undo.)
-			     ;; Don't you dare turn this off for anyone
-			     ;; except yourself.
-			     (load "default" t t)))))))))
-    (if init-file-debug
-	;; Do this without a condition-case if the user wants to debug.
-	(funcall inner)
-      (condition-case error
+  (let (debug-on-error-from-init-file
+	debug-on-error-should-be-set
+	(debug-on-error-initial
+	 (if (eq init-file-debug t) 'startup init-file-debug)))
+    (let ((debug-on-error debug-on-error-initial)
+	  ;; This function actually reads the init files.
+	  (inner
+	   (function
+	    (lambda ()
+	      (if init-file-user
+		  (progn
+		    (setq user-init-file 
+			  (cond 
+			   ((eq system-type 'ms-dos)
+			    (concat "~" init-file-user "/_emacs"))
+			   ((eq system-type 'vax-vms) 
+			    "sys$login:.emacs")
+			   (t 
+			    (concat "~" init-file-user "/.emacs"))))
+		    (load user-init-file t t t)
+		    (or inhibit-default-init
+			(let ((inhibit-startup-message nil))
+			  ;; Users are supposed to be told their rights.
+			  ;; (Plus how to get help and how to undo.)
+			  ;; Don't you dare turn this off for anyone
+			  ;; except yourself.
+			  (load "default" t t)))))))))
+      (if init-file-debug
+	  ;; Do this without a condition-case if the user wants to debug.
 	  (funcall inner)
-	(error (message "Error in init file: %s%s%s"
-			(get (car error) 'error-message)
-			(if (cdr error) ": ")
-			(mapconcat 'prin1-to-string (cdr error) ", "))))))
+	(condition-case error
+	    (progn
+	      (funcall inner)
+	      (setq init-file-had-error nil))
+	  (error (message "Error in init file: %s%s%s"
+			  (get (car error) 'error-message)
+			  (if (cdr error) ": " "")
+			  (mapconcat 'prin1-to-string (cdr error) ", "))
+		 (setq init-file-had-error t))))
+      ;; If we can tell that the init file altered debug-on-error,
+      ;; arrange to preserve the value that it set up.
+      (or (eq debug-on-error debug-on-error-initial)
+	  (setq debug-on-error-should-be-set t
+		debug-on-error-from-init-file debug-on-error)))
+    (if debug-on-error-should-be-set
+	(setq debug-on-error debug-on-error-from-init-file)))
 
   (run-hooks 'after-init-hook)
 
@@ -257,6 +447,31 @@ directory name of the directory where the `.emacs' file was looked for.")
   (if noninteractive (kill-emacs t)))
 
 (defun command-line-1 (command-line-args-left)
+  (or noninteractive (input-pending-p) init-file-had-error
+      (and inhibit-startup-echo-area-message
+	   (let ((buffer (get-buffer-create " *temp*")))
+	     (prog1
+		 (condition-case nil
+		     (save-excursion
+		       (set-buffer buffer)
+		       (insert-file-contents user-init-file)
+		       (re-search-forward
+			(concat
+			 "([ \t\n]*setq[ \t\n]+"
+			 "inhibit-startup-echo-area-message[ \t\n]+"
+			 (regexp-quote
+			  (prin1-to-string
+			   (if (string= init-file-user "")
+			       (user-login-name)
+			     init-file-user)))
+			 "[ \t\n]*)")
+			nil t))
+		   (error nil))
+	       (kill-buffer buffer))))
+      (message (if (eq (key-binding "\C-h\C-p") 'describe-project)
+		   "For information about the GNU Project and its goals, type C-h C-p."
+		 (substitute-command-keys
+		  "For information about the GNU Project and its goals, type \\[describe-project]."))))
   (if (null command-line-args-left)
       (cond ((and (not inhibit-startup-message) (not noninteractive)
 		  ;; Don't clobber a non-scratch buffer if init file
@@ -270,14 +485,26 @@ directory name of the directory where the `.emacs' file was looked for.")
 		  (run-hooks 'term-setup-hook))
 	     ;; Don't let the hook be run twice.
 	     (setq term-setup-hook nil)
+
+	     ;; It's important to notice the user settings before we
+	     ;; display the startup message; otherwise, the settings
+	     ;; won't take effect until the user gives the first
+	     ;; keystroke, and that's distracting.
+	     (if (fboundp 'frame-notice-user-settings)
+		 (frame-notice-user-settings))
+
 	     (and window-setup-hook
 		  (run-hooks 'window-setup-hook))
 	     (setq window-setup-hook nil)
+	     ;; Do this now to avoid an annoying delay if the user
+	     ;; clicks the menu bar during the sit-for.
+	     (precompute-menubar-bindings)
+	     (setq menubar-bindings-done t)
 	     (unwind-protect
 		 (progn
 		   (insert (emacs-version)
 			   "
-Copyright (C) 1991 Free Software Foundation, Inc.\n\n")
+Copyright (C) 1994 Free Software Foundation, Inc.\n\n")
 		   ;; If keys have their default meanings,
 		   ;; use precomputed string to save lots of time.
 		   (if (and (eq (key-binding "\C-h") 'help-command)
@@ -291,6 +518,7 @@ Copyright (C) 1991 Free Software Foundation, Inc.\n\n")
        "Type C-h for help; C-x u to undo changes.  (`C-' means use CTRL key.)
 To kill the Emacs job, type C-x C-c.
 Type C-h t for a tutorial on using Emacs.
+Type C-h i to enter Info, which you can use to read GNU documentation.
 
 GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details.
 You may give out copies of Emacs; type C-h C-c to see the conditions.
@@ -299,6 +527,7 @@ Type C-h C-d for information on getting the latest version.")
        "Type \\[help-command] for help; \\[advertised-undo] to undo changes.  (`C-' means use CTRL key.)
 To kill the Emacs job, type \\[save-buffers-kill-emacs].
 Type \\[help-with-tutorial] for a tutorial on using Emacs.
+Type \\[info] to enter Info, which you can use to read GNU documentation.
 
 GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details.
 You may give out copies of Emacs; type \\[describe-copying] to see the conditions.
@@ -311,7 +540,7 @@ Type \\[describe-distribution] for information on getting the latest version."))
 		 (set-buffer (get-buffer "*scratch*"))
 		 (erase-buffer)
 		 (set-buffer-modified-p nil)))))
-    (let ((dir default-directory)
+    (let ((dir command-line-default-directory)
 	  (file-count 0)
 	  first-file-buffer
 	  (line 0))
@@ -336,10 +565,9 @@ Type \\[describe-distribution] for information on getting the latest version."))
 		       (setq file (expand-file-name file)))
 		   (load file nil t))
 		 (setq command-line-args-left (cdr command-line-args-left)))
-		((or (string-equal argi "-i")
-		     (string-equal argi "-insert"))
+		((string-equal argi "-insert")
 		 (or (stringp (car command-line-args-left))
-		     (error "filename omitted from `-i' option"))
+		     (error "filename omitted from `-insert' option"))
 		 (insert-file-contents (car command-line-args-left))
 		 (setq command-line-args-left (cdr command-line-args-left)))
 		((string-equal argi "-kill")
@@ -370,7 +598,7 @@ Type \\[describe-distribution] for information on getting the latest version."))
       ;; show user what they all are.
       (if (> file-count 2)
 	  (or (get-buffer-window first-file-buffer)
-	      (progn (other-window)
+	      (progn (other-window 1)
 		     (buffer-menu)))))))
 
 ;;; startup.el ends here