xemacs-beta: lisp/prim/startup.el comparison

comparison lisp/prim/startup.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30

author	cvs
date	Mon, 13 Aug 2007 09:02:59 +0200
parents	8d2a9b52c682
children	b9518feda344

comparison

equal deleted inserted replaced

-:804d1389bcd6
+:131b0175ea99
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 ;; General Public License for more details.
 ;; You should have received a copy of the GNU General Public License
 ;; along with XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Free Software Foundation, 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
-;;; Synched up with: FSF 19.28.
+;;; Synched up with: FSF 19.34.
 ;;; Code:
+;;; -batch, -t, and -nw are processed by main() in emacs.c and are
+;;; never seen by lisp code.
+;;; -version and -help are special-cased as well: they imply -batch,
+;;; but are left on the list for lisp code to process.
+(setq top-level '(normal-top-level))
+(defvar command-line-processed nil "t once command line has been processed")
+(defconst startup-message-timeout 120)
+(defconst inhibit-startup-message nil
+"*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.")
+;; #### FSFmacs randomness
+;;(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.")
+(defvar command-line-args-left nil
+"List of command-line args not yet processed.") ; bound by `command-line'
+(defvar command-line-default-directory nil
+"Default directory to use for command line arguments.
+This is normally copied from `default-directory' when XEmacs starts.")
+(defvar before-init-hook nil
+"Functions to call after handling urgent options but before init files.
+The frame system uses this to open frames to display messages while
+XEmacs loads the user's initialization file.")
+(defvar after-init-hook nil
+"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'.")
+(defvar term-setup-hook nil
+"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.
+XEmacs never sets this variable itself.")
+(defvar keyboard-type nil
+"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
+"Normal hook run to initialize window system display.
+XEmacs 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 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.
+Setting `init-file-user' does not prevent Emacs from loading
+`site-start.el'.  The only way to do that is to use `--no-site-file'.")
+;; #### called `site-run-file' in FSFmacs
+(defvar site-start-file (purecopy "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 XEmacs'
+dumped image.  Thus, the run-time load order is: 1. file described in
+this variable, if non-nil; 2. `~/.emacs'; 3. `default.el'.
+Don't use the `site-start.el' file for things some users may not like.
+Put them in `default.el' instead, so that users can more easily
+override them.  Users can prevent loading `default.el' with the `-q'
+option or by setting `inhibit-default-init' in their own init files,
+but inhibiting `site-start.el' requires `--no-site-file', which
+is less convenient.")
+;;(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.")
+(defvar user-mail-address nil
+"*Full mailing address of this user.
+This is initialized based on `mail-host-address',
+after your init file is read, in case it sets `mail-host-address'.")
+(defvar auto-save-list-file-prefix "~/.saves-"
+"Prefix for generating auto-save-list-file-name.
+Emacs's pid and the system name will be appended to
+this prefix to create a unique file name.")
+(defvar init-file-debug nil)
+(defvar init-file-had-error nil)
+(defvar init-file-loaded nil
+"True after the user's init file has been loaded (or suppressed with -q).
+This will be true when `after-init-hook' is run and at all times
+after, and will not be true at any time before.")
+(defvar initial-frame-unmapped-p nil)
+(defvar command-switch-alist
+(purecopy
+'(("-help"	. command-line-do-help)
+("-flags"	. command-line-do-help)
+("-h"	. command-line-do-help)
+("-?"	. command-line-do-help)
+("-version". command-line-do-version)
+("-V"	. command-line-do-version)
+("-funcall". command-line-do-funcall)
+("-f"	. command-line-do-funcall)
+("-e"	. command-line-do-funcall-1)
+("-eval"	. command-line-do-eval)
+("-load"	. command-line-do-load)
+("-l"	. command-line-do-load)
+("-insert"	. command-line-do-insert)
+("-i"	. command-line-do-insert)
+("-kill"	. command-line-do-kill)
+;; Options like +35 are handled specially.
+;; Window-system, site, or package-specific code might add to this.
+;; X11 handles its options by letting Xt remove args from this list.
+))
+"Alist of command-line switches.
+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'.")
+;;; default switches
+;;; Note: these doc strings are semi-magical.
 (defun command-line-do-help (arg)
-"Print this message and exit."
+"Print the XEmacs usage message and exit."
 (let ((standard-output 'external-debugging-output))
-(princ (emacs-version))
+(princ (concat "\n" (emacs-version) "\n\n"))
-(princ "\n\n")
+(princ
-(cond ((fboundp 'x-create-frame)
+(if (featurep 'x)
-	   (princ "XEmacs")
+	 (concat "XEmacs accepts all standard X Toolkit command line options.\n"
-	   (princ " accepts all standard X Toolkit command line options.\
+		 "In addition, the")
-In addition,\nthe "))
+"The"))
-	  (t (princ "The ")))
+(princ " following options are accepted:
-(princ "following options are processed in the order encountered:\n\n")
-(let ((l command-switch-alist)
+-t <device>           Use TTY <device> instead of the terminal for input
-	  (insert (function (lambda (&rest x)
+and output.  This implies the -nw option.
-			      (princ "  ")
+-nw                   Inhibit the use of any window-system-specific
-			      (let ((len 2))
+display code: use the current tty.
-				(while x
+-batch                Execute noninteractively (messages go to stderr).
-				  (princ (car x))
+-debug-init           Enter the debugger if an error in the init file occurs.
-				  (setq len (+ len (length (car x))))
+-unmapped             Do not map the initial frame.
-				  (setq x (cdr x)))
+-no-site-file         Do not load the site-specific init file (site-start.el).
-				(if (>= len 24)
+-no-init-file         Do not load the user-specific init file (~/.emacs).
-				    (progn (terpri) (setq len 0)))
+-q                    Same as -no-init-file.
-				(while (< len 24)
+-user <user>          Load user's init file instead of your own.
-				  (princ " ")
+-u <user>             Same as -user.\n")
-				  (setq len (1+ len))))))))
+(let ((l command-switch-alist)
+	  (insert (lambda (&rest x)
+		    (princ "  ")
+		    (let ((len 2))
+		      (while x
+			(princ (car x))
+			(incf len (length (car x)))
+			(setq x (cdr x)))
+		      (when (>= len 24)
+			(terpri) (setq len 0))
+		      (while (< len 24)
+			(princ " ")
+			(incf len))))))
 (while l
 (let ((name (car (car l)))
 (fn (cdr (car l)))
 	      doc arg cons)
 	  (cond
 	    (terpri))))
 (setq l (cdr l))))
 (princ "\
 +N <file>             Start displaying <file> at line N.
-These options are processed only if they appear before all other options:
--t <device>           Use TTY <device> instead of the terminal for input
-and output.  This implies the -nw option.
--batch                Execute noninteractively (messages go to stderr).
-This option must be first in the list after -t.
--nw                   Inhibit the use of any window-system-specific
-display code: use the current tty.
--debug-init           Enter the debugger if an error in the init file occurs.
--unmapped             Do not map the initial frame.
--no-site-file         Do not load the site-specific init file (site-start.el).
--no-init-file         Do not load the user-specific init file (~/.emacs).
--q                    Same as -no-init-file.
--user <user>          Load user's init file instead of your own.
--u <user>             Same as -user.")
-(princ "
 Anything else is considered a file name, and is placed into a buffer for
 editing.
 XEmacs has an online tutorial and manuals.  Type ^Ht (Control-h t) after
-starting XEmacs to run the tutorial.  Type ^Hi to enter the manual browser.\n")
+starting XEmacs to run the tutorial.  Type ^Hi to enter the manual browser.
-(kill-emacs 0)
+Type ^H^H^H (Control-h Control-h Control-h) to get more help options.\n")
-))
+(kill-emacs 0)))
-;;; -batch, -t, and -nw are processed by main() in emacs.c and are
-;;; never seen by lisp code.
-;;; -version and -help are special-cased as well: they imply -batch,
-;;; but are left on the list for lisp code to process.
-(setq top-level '(normal-top-level))
-(defvar command-line-processed nil "t once command line has been processed")
-(defconst startup-message-timeout 1200) ; More or less disable the timeout
-(defconst inhibit-startup-message nil
-"*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.")
-;; #### FSFmacs randomness
-;(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.")
-(defconst command-switch-alist nil
-"Alist of command-line switches.
-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.") ; bound by `command-line'
-(defvar command-line-default-directory nil
-"Default directory to use for command line arguments.
-This is normally copied from `default-directory' when XEmacs starts.")
-(defvar before-init-hook nil
-"Functions to call after handling urgent options but before init files.
-The frame system uses this to open frames to display messages while
-XEmacs loads the user's initialization file.")
-(defvar after-init-hook nil
-"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'.")
-(defvar term-setup-hook nil
-"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.
-XEmacs never sets this variable itself.")
-(defvar keyboard-type nil
-"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
-"Normal hook run to initialize window system display.
-XEmacs 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 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.
-Setting `init-file-user' does not prevent Emacs from loading
-`site-start.el'.  The only way to do that is to use `--no-site-file'.")
-;; #### called `site-run-file' in FSFmacs
-(defvar site-start-file (purecopy "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 XEmacs'
-dumped image.  Thus, the run-time load order is: 1. file described in
-this variable, if non-nil; 2. `~/.emacs'; 3. `default.el'.
-Don't use the `site-start.el' file for things some users may not like.
-Put them in `default.el' instead, so that users can more easily
-override them.  Users can prevent loading `default.el' with the `-q'
-option or by setting `inhibit-default-init' in their own init files,
-but inhibiting `site-start.el' requires `--no-site-file', which
-is less convenient.")
-;(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.")
-(defvar user-mail-address nil
-"*Full mailing address of this user.
-This is initialized based on `mail-host-address',
-after your init file is read, in case it sets `mail-host-address'.")
-(defvar auto-save-list-file-prefix "~/.saves-"
-"Prefix for generating auto-save-list-file-name.
-Emacs's pid and the system name will be appended to
-this prefix to create a unique file name.")
-(defvar init-file-debug nil)
-(defvar init-file-had-error nil)
-(defvar init-file-loaded nil
-"True after the user's init file has been loaded (or suppressed with -q).
-This will be true when `after-init-hook' is run and at all times
-after, and will not be true at any time before.")
-(defvar initial-frame-unmapped-p nil)
-;;; default switches
-;;; Note: these doc strings are semi-magical.
 (defun command-line-do-funcall (arg)
 "Invoke the named lisp function with no arguments.
 <function>"
-(let ((fn (intern (car command-line-args-left))))
+(funcall (intern (pop command-line-args-left))))
-(setq command-line-args-left (cdr command-line-args-left))
-(funcall fn)))
 (fset 'command-line-do-funcall-1 'command-line-do-funcall)
 (put 'command-line-do-funcall-1 'undocumented t)
 (defun command-line-do-eval (arg)
 "Evaluate the lisp form.  Quote it carefully.
 <form>"
-(let ((form (car command-line-args-left)))
+(eval (read (pop command-line-args-left))))
-(setq command-line-args-left (cdr command-line-args-left))
-(eval (read form))))
 (defun command-line-do-load (arg)
 "Load the named file of Lisp code into XEmacs.
 <file>"
-(let ((file (car command-line-args-left)))
+(let ((file (pop command-line-args-left)))
 ;; Take file from default dir if it exists there;
 ;; otherwise let `load' search for it.
 (if (file-exists-p (expand-file-name file))
 	(setq file (expand-file-name file)))
-(load file nil t))
+(load file nil t)))
-(setq command-line-args-left (cdr command-line-args-left)))
 (defun command-line-do-insert (arg)
 "Insert file into the current buffer.
 <file>"
-(insert-file-contents (car command-line-args-left))
+(insert-file-contents (pop command-line-args-left)))
-(setq command-line-args-left (cdr command-line-args-left)))
 (defun command-line-do-kill (arg)
 "Exit XEmacs."
 (kill-emacs t))
 (defun command-line-do-version (arg)
 "Print version info and exit."
-(princ (concat (emacs-version) "\n") 'external-debugging-output)
+(princ (concat (emacs-version) "\n"))
 (kill-emacs 0))
-(setq command-switch-alist
-(purecopy
-'(("-help"	. command-line-do-help)
-	 ("-version"	. command-line-do-version)
-	 ("-funcall"	. command-line-do-funcall)
-("-f"		. command-line-do-funcall)
-	 ("-e"		. command-line-do-funcall-1)
-	 ("-eval"	. command-line-do-eval)
-	 ("-load"	. command-line-do-load)
-	 ("-l"		. command-line-do-load)
-	 ("-insert"	. command-line-do-insert)
-	 ("-i"		. command-line-do-insert)
-	 ("-kill"	. command-line-do-kill)
-	 ;; Options like +35 are handled specially.
-	 ;; Window-system, site, or package-specific code might add to this.
-	 ;; X11 handles its options by letting Xt remove args from this list.
-	 )))
 ;;; Processing the command line and loading various init files
 (defun early-error-handler (&rest debugger-args)
 "You should probably not be using this."
 (if (memq (car-safe error) '(void-function void-variable))
 	  (princ "
 	This probably means that XEmacs is picking up an old version of
 	the lisp library, or that some .elc files are not up-to-date.\n"
 		 stream)))
-(if (not suppress-early-error-handler-backtrace)
+(when (not suppress-early-error-handler-backtrace)
-	(let ((print-length 1000)
+(let ((print-length 1000)
-	      (print-level 1000)
+	    (print-level 1000)
-	      (print-escape-newlines t)
+	    (print-escape-newlines t)
-	      (print-readably nil))
+	    (print-readably nil))
-	  (if (getenv "EMACSLOADPATH")
+	(when (getenv "EMACSLOADPATH")
-	      (princ (format "\n$EMACSLOADPATH is %s" (getenv "EMACSLOADPATH"))
+	  (princ (format "\n$EMACSLOADPATH is %s" (getenv "EMACSLOADPATH"))
-		     stream))
+		 stream))
-	  (princ (format "\nexec-directory is %S" exec-directory) stream)
+	(princ (format "\nexec-directory is %S" exec-directory) stream)
-	  (princ (format "\ndata-directory is %S" data-directory) stream)
+	(princ (format "\ndata-directory is %S" data-directory) stream)
-	  (princ (format "\ndoc-directory is %S" doc-directory) stream)
+	(princ (format "\ndoc-directory is %S" doc-directory) stream)
-	  (princ (format "\nload-path is %S" load-path) stream)
+	(princ (format "\nload-path is %S" load-path) stream)
-	  (princ "\n\n" stream)))
+	(princ "\n\n" stream)))
-(if (not suppress-early-error-handler-backtrace)
+(when (not suppress-early-error-handler-backtrace)
-	(backtrace stream t)))
+(backtrace stream t)))
 (kill-emacs -1))
 (defun normal-top-level ()
 (if command-line-processed
 (message "Back to top level.")
 (setq command-line-processed t)
 ;; Canonicalize HOME (PWD is canonicalized by init_buffer in buffer.c)
-(if (not (eq system-type 'vax-vms))
+(unless (eq system-type 'vax-vms)
 (let ((value (getenv "HOME")))
-(if (and value
+	(if (and value
-(< (length value) (length default-directory))
+		 (< (length value) (length default-directory))
-(equal (file-attributes default-directory)
+		 (equal (file-attributes default-directory)
-(file-attributes value)))
+			(file-attributes value)))
-(setq default-directory (file-name-as-directory value)))))
+	    (setq default-directory (file-name-as-directory value)))))
 (setq default-directory (abbreviate-file-name default-directory))
 (initialize-xemacs-paths)
 (unwind-protect
 	(command-line)
 ;; Do this again, in case .emacs defined more abbreviations.
 		     (system-name))))
 (run-hooks 'emacs-startup-hook)
 (and term-setup-hook
 	   (run-hooks 'term-setup-hook))
 (setq term-setup-hook nil)
-;      ;; Modify the initial frame based on what .emacs puts into
+;;      ;; Modify the initial frame based on what .emacs puts into
-;      ;; ...-frame-alist.
+;;      ;; ...-frame-alist.
 (frame-notice-user-settings)
-;      ;;####FSFmacs junk
+;;      ;;####FSFmacs junk
-;      ;; Now we know the user's default font, so add it to the menu.
+;;      ;; Now we know the user's default font, so add it to the menu.
-;      (if (fboundp 'font-menu-add-default)
+;;      (if (fboundp 'font-menu-add-default)
-;	  (font-menu-add-default))
+;;	  (font-menu-add-default))
-(and window-setup-hook
+(when window-setup-hook
-	   (run-hooks 'window-setup-hook))
+	(run-hooks 'window-setup-hook))
 (setq window-setup-hook nil))
 ;;####FSFmacs junk
-;      (or menubar-bindings-done
+;;      (or menubar-bindings-done
-;	  (precompute-menubar-bindings))
+;;	  (precompute-menubar-bindings))
 ))
 ;;####FSFmacs junk
 ;;; Precompute the keyboard equivalents in the menu bar items.
-;(defun precompute-menubar-bindings ()
+;;(defun precompute-menubar-bindings ()
-;  (if (eq window-system 'x)
+;;  (if (eq window-system 'x)
-;      (let ((submap (lookup-key global-map [menu-bar])))
+;;      (let ((submap (lookup-key global-map [menu-bar])))
-;	(while submap
+;;	(while submap
-;	  (and (consp (car submap))
+;;	  (and (consp (car submap))
-;	       (symbolp (car (car submap)))
+;;	       (symbolp (car (car submap)))
-;	       (stringp (car-safe (cdr (car submap))))
+;;	       (stringp (car-safe (cdr (car submap))))
-;	       (keymapp (cdr (cdr (car submap))))
+;;	       (keymapp (cdr (cdr (car submap))))
-;	       (x-popup-menu nil (cdr (cdr (car submap)))))
+;;	       (x-popup-menu nil (cdr (cdr (car submap)))))
-;	  (setq submap (cdr submap))))))
+;;	  (setq submap (cdr submap))))))
-(defun command-line-early ()
+(defun command-line-early (args)
 ;; This processes those switches which need to be processed before
 ;; starting up the window system.
 (setq command-line-default-directory default-directory)
 	   (setq version-control nil))
 	  ((or (string= vc "never")
 	       (string= vc "simple"))
 	   (setq version-control 'never))))
 ;;####FSFmacs
-;  (if (let ((ctype
+;;  (if (let ((ctype
-;	     ;; Use the first of these three envvars that has a nonempty value.
+;;	     ;; Use the first of these three envvars that has a nonempty value.
-;	     (or (let ((string (getenv "LC_ALL")))
+;;	     (or (let ((string (getenv "LC_ALL")))
-;		   (and (not (equal string "")) string))
+;;		   (and (not (equal string "")) string))
-;		 (let ((string (getenv "LC_CTYPE")))
+;;		 (let ((string (getenv "LC_CTYPE")))
-;		   (and (not (equal string "")) string))
+;;		   (and (not (equal string "")) string))
-;		 (let ((string (getenv "LANG")))
+;;		 (let ((string (getenv "LANG")))
-;		   (and (not (equal string "")) string)))))
+;;		   (and (not (equal string "")) string)))))
-;	(and ctype
+;;	(and ctype
-;	     (string-match iso-8859-1-locale-regexp ctype)))
+;;	     (string-match iso-8859-1-locale-regexp ctype)))
-;      (progn
+;;      (progn
-;	(standard-display-european t)
+;;	(standard-display-european t)
-;	(require 'iso-syntax)))
+;;	(require 'iso-syntax)))
-(let ((done nil))
+;; Figure out which user's init file to load,
-;; Figure out which user's init file to load,
+;; either from the environment or from the options.
-;; either from the environment or from the options.
+(setq init-file-user (if (noninteractive) nil (user-login-name)))
-(setq init-file-user (if (noninteractive) nil (user-login-name)))
+;; If user has not done su, use current $HOME to find .emacs.
-;; If user has not done su, use current $HOME to find .emacs.
+(and init-file-user (string= init-file-user (user-real-login-name))
-(and init-file-user (string= init-file-user (user-real-login-name))
+(setq init-file-user ""))
-	 (setq init-file-user ""))
+;; Allow (at least) these arguments anywhere in the command line
-(while (and (not done) command-line-args-left)
+(let ((new-args nil)
-(let ((argi (car command-line-args-left)))
+	(arg      nil))
-	(cond ((or (string-equal argi "-q")
+(while args
-		   (string-equal argi "-no-init-file"))
+(setq arg (pop args))
-	       (setq init-file-user nil
+(cond
-		     command-line-args-left (cdr command-line-args-left)))
+((or (string= arg "-q")
-	      ((string-equal argi "-no-site-file")
+	    (string= arg "-no-init-file"))
-	       (setq site-start-file nil
+	(setq init-file-user nil))
-		     command-line-args-left (cdr command-line-args-left)))
+((string= arg "-no-site-file")
-	      ((or (string-equal argi "-u")
+	(setq site-start-file nil))
-		   (string-equal argi "-user"))
+((or (string= arg "-u")
-	       (setq command-line-args-left (cdr command-line-args-left)
+	    (string= arg "-user"))
-		     init-file-user (car command-line-args-left)
+	(setq init-file-user (pop args)))
-		     command-line-args-left (cdr command-line-args-left)))
+((string= arg "-debug-init")
-((string-equal argi "-debug-init")
+	(setq init-file-debug t))
-(setq init-file-debug t
+((string= arg "-unmapped")
-command-line-args-left (cdr command-line-args-left)))
+	(setq initial-frame-unmapped-p t))
-((string-equal argi "-unmapped")
+((or (string= arg "--") (string= arg "-"))
-(setq initial-frame-unmapped-p t
+	(while args
-command-line-args-left (cdr command-line-args-left)))
+	  (push (pop args) new-args)))
-	      (t (setq done t)))))))
+(t (push arg new-args))))
+(nreverse new-args)))
 (defun command-line ()
 (let ((command-line-args-left (cdr command-line-args)))
 (let ((debugger 'early-error-handler)
 ;; Process magic command-line switches like -q and -u.  Do this
 ;; before creating the first frame because some of these switches
 ;; may affect that.  I think it's ok to do this before establishing
 ;; the X connection, and maybe someday things like -nw can be
 ;; handled here instead of down in C.
-(command-line-early)
+(setq command-line-args-left (command-line-early command-line-args-left))
 ;; Setup the toolbar icon directory
-(if (featurep 'toolbar)
+(when (featurep 'toolbar)
-(init-toolbar-location))
+	(init-toolbar-location))
-;; Initialize the built-in glyphs and the default specifier
+;; Initialize the built-in glyphs and default specifier lists
-;; lists
+(when (not noninteractive)
-(if (not noninteractive)
+	(init-glyphs))
-	  (init-glyphs))
 ;; Run the window system's init function.  tty is considered to be
 ;; a type of window system for this purpose.  This creates the
 ;; initial (non stdio) device.
-(if (and initial-window-system (not noninteractive))
+(when (and initial-window-system (not noninteractive))
-	  (funcall (intern (concat "init-"
+	(funcall (intern (concat "init-"
-				   (symbol-name initial-window-system)
+				 (symbol-name initial-window-system)
-				   "-win"))))
+				 "-win"))))
 ;; When not in batch mode, this creates the first visible frame,
 ;; and deletes the stdio device.
 (frame-initialize))
 ;;; Load init files.
 (load-init-file)
 ;; If *scratch* exists and init file didn't change its mode, initialize it.
-(if (get-buffer "*scratch*")
+(when (get-buffer "*scratch*")
-	(save-excursion
+(save-excursion
-	  (set-buffer "*scratch*")
+	(set-buffer "*scratch*")
-	  (if (eq major-mode 'fundamental-mode)
+	(when (eq major-mode 'fundamental-mode)
-	      (funcall initial-major-mode))))
+	  (funcall initial-major-mode))))
 ;; Load library for our terminal type.
 ;; User init file can set term-file-prefix to nil to prevent this.
 ;; Note that for any TTY's opened subsequently, the TTY init
 ;; code will run this.
-(if (and (eq 'tty (console-type))
+(when (and (eq 'tty (console-type))
-	     (not (noninteractive)))
+	       (not (noninteractive)))
-	(load-terminal-library))
+(load-terminal-library))
 ;; Process the remaining args.
 (command-line-1)
 ;; it was turned on by default so that the warnings don't get displayed
 ;; until after the splash screen.
 (setq inhibit-warning-display nil)
 ;; If -batch, terminate after processing the command options.
-(if (noninteractive) (kill-emacs t))))
+(when (noninteractive) (kill-emacs t))))
 (defun load-terminal-library ()
-(and term-file-prefix
+(when term-file-prefix
 (let ((term (getenv "TERM"))
-	     hyphend)
+	  hyphend)
-	 (while (and term
+(while (and term
-		     (not (load (concat term-file-prefix term) t t)))
+		  (not (load (concat term-file-prefix term) t t)))
-	   ;; Strip off last hyphen and what follows, then try again
+	;; Strip off last hyphen and what follows, then try again
-	   (if (setq hyphend (string-match "[-_][^-_]+\\'" term))
+	(if (setq hyphend (string-match "[-_][^-_]+\\'" term))
-	       (setq term (substring term 0 hyphend))
+	    (setq term (substring term 0 hyphend))
-	     (setq term nil))))))
+	  (setq term nil))))))
 (defun load-user-init-file (init-file-user)
 ;; This function actually reads the init files.
-(if init-file-user
+(when init-file-user
-(progn
+(setq user-init-file
-	(setq user-init-file
+	  (cond
-	      (cond
+	   ((eq system-type 'ms-dos)
-	       ((eq system-type 'ms-dos)
+	    (concat "~" init-file-user "/_emacs"))
-		(concat "~" init-file-user "/_emacs"))
+	   ((eq system-type 'vax-vms)
-	       ((eq system-type 'vax-vms)
+	    "sys$login:.emacs")
-		"sys$login:.emacs")
+	   (t
-	       (t
+	    (concat "~" init-file-user "/.emacs"))))
-		(concat "~" init-file-user "/.emacs"))))
+(load user-init-file t t t)
-	(load user-init-file t t t)
+(unless inhibit-default-init
-	(or inhibit-default-init
+(let ((inhibit-startup-message nil))
-	    (let ((inhibit-startup-message nil))
+	;; Users are supposed to be told their rights.
-	      ;; Users are supposed to be told their rights.
+	;; (Plus how to get help and how to undo.)
-	      ;; (Plus how to get help and how to undo.)
+	;; Don't you dare turn this off for anyone except yourself.
-	      ;; Don't you dare turn this off for anyone
+	(load "default" t t)))))
-	      ;; except yourself.
-	      (load "default" t t))))))
 ;;; Load user's init file and default ones.
 (defun load-init-file ()
 (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-start-file
+(when site-start-file
 (load site-start-file t t))
 ;; Sites should not disable this.  Only individuals should disable
 ;; the startup message.
 (setq inhibit-startup-message nil)
 ;; 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
+(when debug-on-error-should-be-set
-	(setq debug-on-error debug-on-error-from-init-file)))
+(setq debug-on-error debug-on-error-from-init-file)))
 (setq init-file-loaded t)
 ;; Do this here in case the init file sets mail-host-address.
-;; Don't do this here unless noninteractive, it is frequently wrong. -sb
 (or user-mail-address
 (setq user-mail-address (concat (user-login-name) "@"
 				      (or mail-host-address
 					  (system-name)))))
 a new format, when variables have changed, etc."
 (load filename))
 (defun command-line-1 ()
 (if (null command-line-args-left)
-(cond ((and (not inhibit-startup-message) (not (noninteractive))
+(unless (or inhibit-startup-message
+		  noninteractive
 		  ;; Don't clobber a non-scratch buffer if init file
 		  ;; has selected it.
-		  (string= (buffer-name) "*scratch*")
+		  (not (string= (buffer-name) "*scratch*"))
-		  (not (input-pending-p)))
+		  (input-pending-p))
-	     ;; If there are no switches to process, run the term-setup-hook
+	;; If there are no switches to process, run the term-setup-hook
-	     ;; before displaying the copyright notice; there may be some need
+	;; before displaying the copyright notice; there may be some need
-	     ;; to do it before doing any output.  If we're not going to
+	;; to do it before doing any output.  If we're not going to
-	     ;; display a copyright notice (because other options are present)
+	;; display a copyright notice (because other options are present)
-	     ;; then this is run after those options are processed.
+	;; then this is run after those options are processed.
-	     (run-hooks 'term-setup-hook)
+	(run-hooks 'term-setup-hook)
-	     ;; Don't let the hook be run twice.
+	;; Don't let the hook be run twice.
-	     (setq term-setup-hook nil)
+	(setq term-setup-hook nil)
-(let ((timeout nil))
+	(let ((timeout nil))
-(unwind-protect
+	  (unwind-protect
-;; Guts of with-timeout
+	      ;; Guts of with-timeout
-(catch 'timeout
+	      (catch 'timeout
-(setq timeout (add-timeout startup-message-timeout
+		(setq timeout (add-timeout startup-message-timeout
-#'(lambda (ignore)
+					   (lambda (ignore)
-(condition-case nil
+					     (condition-case nil
-(throw 'timeout t)
+						 (throw 'timeout t)
-(error nil)))
+					       (error nil)))
-nil))
+					   nil))
-(startup-splash-frame)
+		(startup-splash-frame)
-(or nil ;; (pos-visible-in-window-p (point-min))
+		(or nil;; (pos-visible-in-window-p (point-min))
-(goto-char (point-min)))
+		    (goto-char (point-min)))
-(sit-for 0)
+		(sit-for 0)
-(setq unread-command-event (next-command-event)))
+		(setq unread-command-event (next-command-event)))
-(if timeout (disable-timeout timeout))
+	    (when timeout (disable-timeout timeout))
-(save-excursion
+	    (save-excursion
-;; In case the XEmacs server has already selected
+	      ;; In case the XEmacs server has already selected
-;; another buffer, erase the one our message is in.
+	      ;; another buffer, erase the one our message is in.
-		   (progn
+	      (set-buffer (get-buffer "*scratch*"))
-		     (set-buffer (get-buffer "*scratch*"))
+	      (erase-buffer)
-		     (erase-buffer)
+	      (set-buffer-modified-p nil)))))
-		     (set-buffer-modified-p nil)))))))
+;; Command-line-options exist
 (let ((dir command-line-default-directory)
 	  (file-count 0)
-	  first-file-buffer
+	  (line nil)
-	  (line nil))
+	  (end-of-options nil)
+	  first-file-buffer file-p arg tem)
 (while command-line-args-left
-	(let ((argi (car command-line-args-left))
+	(setq arg (pop command-line-args-left))
-	      tem)
+	(cond
-	  (setq command-line-args-left (cdr command-line-args-left))
+	 (end-of-options
-	  (or (cond (line
+	  (setq file-p t))
-		     nil)
+	 ((setq tem (when (eq (aref arg 0) ?-)
-		    ((setq tem (or (assoc argi command-switch-alist)
+		      (or (assoc arg command-switch-alist)
-				   (and (string-match "\\`--" argi)
+			  (assoc (substring arg 1)
-					(assoc (substring argi 1)
+				 command-switch-alist))))
-					       command-switch-alist))))
+	  (funcall (cdr tem) arg))
-		     (funcall (cdr tem) argi)
+	 ((string-match "\\`\\+[0-9]+\\'" arg)
-		     t)
+	  (setq line (string-to-int arg)))
-		    ((string-match "\\`\\+[0-9]+\\'" argi)
+	 ;; "- file" means don't treat "file" as a switch
-		     (setq line (string-to-int argi))
+	 ;;  ("+0 file" has the same effect; "-" added
-		     t)
+	 ;;   for unixoidiality).
-		    ((or (equal argi "-") (equal argi "--"))
+	 ;; This is worthless; the `unixoid' way is "./file". -jwz
-		     ;; "- file" means don't treat "file" as a switch
+	 ((or (string= arg "-") (string= arg "--"))
-		     ;;  ("+0 file" has the same effect; "-" added
+	  (setq end-of-options t))
-		     ;;   for unixoidiality).
+	 (t
-		     ;; This is worthless; the `unixoid' way is "./file". -jwz
+	  (setq file-p t)))
-		     (setq line 0))
-		    (t
+	(when file-p
-		     nil))
+	  (setq file-p nil)
-	      (progn
+	  (incf file-count)
-		(setq file-count (1+ file-count))
+	  (setq arg (expand-file-name arg dir))
-		(setq argi (expand-file-name argi dir))
+	  (cond
-		(if (= file-count 1)
+	   ((= file-count 1) (setq first-file-buffer
-		    (setq first-file-buffer (progn (find-file argi)
+				   (progn (find-file arg) (current-buffer))))
-						   (current-buffer)))
+	   (noninteractive (find-file arg))
-		  (if noninteractive
+	   (t (find-file-other-window arg)))
-		      (find-file argi)
+	  (when line
-		    (find-file-other-window argi)))
+	    (goto-line line)
-		(or (null line)
+	    (setq line nil))))
-		    (zerop line)
-		    (goto-line line))
-		(setq line 0)))))
 ;; If 3 or more files visited, and not all visible,
 ;; show user what they all are.
-(if (and (not noninteractive)
+(when (and (not noninteractive)
-	       (> file-count 2))
+		 (> file-count 2)
-	  (or (get-buffer-window first-file-buffer)
+		 (not (get-buffer-window first-file-buffer)))
-	      (progn (other-window 1)
+	(other-window 1)
-		     (buffer-menu nil)))))))
+	(buffer-menu nil)))))
 (defvar startup-presentation-hack-keymap
 (let ((map (make-sparse-keymap)))
 (set-keymap-name map 'startup-presentation-hack-keymap)
 (define-key map '[button1] 'startup-presentation-hack)
 (event-buffer e)
 'startup-presentation-hack))
 (setq e (extent-property e 'startup-presentation-hack))
 (if (consp e)
 (apply (car e) (cdr e))
-(progn
+	   (while (keymapp (indirect-function e))
-(while (keymapp (indirect-function e))
+	     (let ((map e)
-(let ((map e)
+		   (overriding-local-map (indirect-function e)))
-(overriding-local-map (indirect-function e)))
+	       (setq e (read-key-sequence
-(setq e (read-key-sequence
+			(let ((p (keymap-prompt map t)))
-(let ((p (keymap-prompt map t)))
+			  (cond ((symbolp map)
-(cond ((symbolp map)
+				 (if p
-(if p
+				     (format "%s %s " map p)
-(format "%s %s " map p)
+				   (format "%s " map)))
-(format "%s " map p)))
+				(p)
-(p)
+				(t
-(t
+				 (prin1-to-string map))))))
-(prin1-to-string map))))))
+	       (if (and (button-release-event-p (elt e 0))
-(if (and (button-release-event-p (elt e 0))
+			(null (key-binding e)))
-(null (key-binding e)))
+		   (setq e map)		; try again
-(setq e map)       ; try again
+		 (setq e (key-binding e)))))
-(setq e (key-binding e)))))
+	   (call-interactively e)))))
-(call-interactively e))))))
 (defun startup-presentation-hack-help (e)
 (setq e (extent-property e 'startup-presentation-hack))
 (if (consp e)
 (format "Evaluate %S" e)
 (symbol-name e)))
 (defun splash-frame-present-hack (e v)
-;  (set-extent-property e 'mouse-face 'highlight)
+;;  (set-extent-property e 'mouse-face 'highlight)
-;  (set-extent-property e 'keymap
+;;  (set-extent-property e 'keymap
-;                       startup-presentation-hack-keymap)
+;;                       startup-presentation-hack-keymap)
-;  (set-extent-property e 'startup-presentation-hack v)
+;;  (set-extent-property e 'startup-presentation-hack v)
-;  (set-extent-property e 'help-echo
+;;  (set-extent-property e 'help-echo
-;                       'startup-presentation-hack-help))
+;;                       'startup-presentation-hack-help))
 )
-(defun splash-hack-version-string ()
-(save-excursion
-(save-restriction
-(goto-char (point-min))
-(re-search-forward "^XEmacs" nil t)
-(narrow-to-region (point-at-bol) (point-at-eol))
-(goto-char (point-min))
-(when (re-search-forward " \\[Lucid\\]" nil t)
-	(delete-region (match-beginning 0) (match-end 0)))
-(when (re-search-forward "[^(][^)]*-[^)]*-" nil t)
-	(delete-region (1+ (match-beginning 0)) (match-end 0))
-	(insert "("))
-(goto-char (point-max))
-(search-backward " " nil t)
-(when (search-forward "." nil t)
-	(delete-region (1- (point)) (point-max))))))
 (defun splash-frame-present (l)
 (cond ((stringp l)
-(insert l)
+(insert l))
-	 (splash-hack-version-string))
 ((eq (car-safe l) 'face)
 ;; (face name string)
 (let ((p (point)))
 (splash-frame-present (elt l 2))
 (if (fboundp 'set-extent-face)
 ((eq (car-safe l) 'key)
 (let* ((c (elt l 1))
 (p (point))
 (k (where-is-internal c nil t)))
 (insert (if k (key-description k)
-(format "M-x %s" c)))
+		     (format "M-x %s" c)))
 (if (fboundp 'set-extent-face)
 (let ((e (make-extent p (point))))
 (set-extent-face e 'bold)
 (splash-frame-present-hack e c)))))
 ((eq (car-safe l) 'funcall)
 ;; (funcall (fun . args) string)
 (let ((p (point)))
 (splash-frame-present (elt l 2))
 (if (fboundp 'set-extent-face)
 (splash-frame-present-hack (make-extent p (point))
-(elt l 1)))))
+					  (elt l 1)))))
 	((consp l)
 	 (mapcar 'splash-frame-present l))
 (t
 (error "WTF!?"))))
 (+ left-margin
 (round (/ (/ (- fill-area-width glyph-pixwidth) 2) avg-pixwidth)))))
 (defun startup-splash-frame-body ()
 `("\n" ,(emacs-version) "\n"
-,@(if (string-match "beta" emacs-version)
-	  `( (face (bold blue) ( "This is an Experimental version of XEmacs. "
-				 " Type " (key describe-beta)
-				 " to see what this means.\n")))
-	`( "\n"))
 (face bold-italic "\
-Copyright (C) 1985-1997 Free Software Foundation, Inc.
+Copyright (C) 1985-1996 Free Software Foundation, Inc.
 Copyright (C) 1990-1994 Lucid, Inc.
-Copyright (C) 1993-1997 Sun Microsystems, Inc. All Rights Reserved.
+Copyright (C) 1993-1996 Sun Microsystems, Inc. All Rights Reserved.
 Copyright (C) 1994-1996 Board of Trustees, University of Illinois
 Copyright (C) 1995-1996 Ben Wing\n\n")
 ,@(if (featurep 'sparcworks)
 `( "\
 Sun provides support for the WorkShop/XEmacs integration package only.
 All other XEmacs packages are provided to you \"AS IS\".
 For full details, type " (key describe-no-warranty)
 " to refer to the GPL Version 2, dated June 1991.\n\n"
-,@(let ((lang (or (getenv "LANG") (getenv "LC_ALL"))))
+,@(let ((lang (or (getenv "LC_ALL") (getenv "LC_MESSAGES") (getenv "LANG"))))
 (if (and
 (not (featurep 'mule))         ; Already got mule?
 (not (eq 'tty (console-type))) ; No Mule support on tty's yet
 lang                           ; Non-English locale?
-(not (string-equal lang "C"))
+(not (string= lang "C"))
 (not (string-match "^en" lang))
 (locate-file "xemacs-mule" exec-path)) ; Comes with Sun WorkShop
 '( "\
 This version of XEmacs has been built with support for Latin-1 languages only.
 To handle other languages you need to run a Multi-lingual (`Mule') version of
 "Type " (key help-command) " or use the " (face bold "Help") " menu to get help.\n"
 "Type " (key advertised-undo) " to undo changes  (`C-' means use the Control key).\n"
 "To get out of XEmacs, type " (key save-buffers-kill-emacs) ".\n"
 "Type " (key help-with-tutorial) " for a tutorial on using XEmacs.\n"
 "Type " (key info) " to enter Info, "
-"which you can use to read online documentation.\n"
+"which you can use to read online documentation.\n\n"
 (face (bold red) ( "\
 For tips and answers to frequently asked questions, see the XEmacs FAQ.
 \(It's on the Help menu, or type " (key xemacs-local-faq) " [a capital F!].\)"))))
 (defun startup-splash-frame ()
 (indent-to (startup-center-spaces xemacs-logo))
 (set-extent-begin-glyph (make-extent (point) (point)) xemacs-logo)
 (insert (if cramped-p "\n" "\n\n"))
 (splash-frame-present-hack (make-extent p (point)) 'about-xemacs))
-(let ((after-change-functions nil)) ; no font-lock, thank you
+(let ((after-change-functions nil))	; no font-lock, thank you
 (dolist (l (startup-splash-frame-body))
 (splash-frame-present l)))
 (set-buffer-modified-p nil))
-;  (let ((present-file
+;;  (let ((present-file
-;         #'(lambda (f)
+;;         #'(lambda (f)
-;             (splash-frame-present
+;;             (splash-frame-present
-;	      (list 'funcall
+;;	      (list 'funcall
-;		    (list 'find-file-other-window
+;;		    (list 'find-file-other-window
-;			  (expand-file-name f data-directory))
+;;			  (expand-file-name f data-directory))
-;		    f)))))
+;;		    f)))))
-;    (insert "For customization examples, see the files ")
+;;    (insert "For customization examples, see the files ")
-;    (funcall present-file "sample.emacs")
+;;    (funcall present-file "sample.emacs")
-;    (insert " and ")
+;;    (insert " and ")
-;    (funcall present-file "sample.Xdefaults")
+;;    (funcall present-file "sample.Xdefaults")
-;    (insert (format "\nin the directory %s." data-directory)))
+;;    (insert (format "\nin the directory %s." data-directory)))
 ;;;; Computing the default load-path, etc.
 ;;;
 ;;; This stuff is a complete mess and isn't nearly as general as it
 ;;; which of those three layouts is mostly in place, so that we can suggest
 ;;; the right directories in the error message.
 ;; extremely low-tech debugging, since this happens so early in startup.
-;(or (fboundp 'orig-file-directory-p)
+;;(or (fboundp 'orig-file-directory-p)
-;    (fset 'orig-file-directory-p (symbol-function 'file-directory-p)))
+;;    (fset 'orig-file-directory-p (symbol-function 'file-directory-p)))
-;(defun file-directory-p (path)
+;;(defun file-directory-p (path)
-;  (send-string-to-terminal (format "PROBING %S" path))
+;;  (send-string-to-terminal (format "PROBING %S" path))
-;  (let ((v (orig-file-directory-p path)))
+;;  (let ((v (orig-file-directory-p path)))
-;    (send-string-to-terminal (format " -> %S\n" v))
+;;    (send-string-to-terminal (format " -> %S\n" v))
-;    v))
+;;    v))
 (defun startup-make-version-dir ()
 (let ((version (and (string-match "\\`[^0-9]*\\([0-9]+\\.[0-9]+\\)"
 				    emacs-version)
 		      (substring emacs-version
 ;; general direction of a clue.
 ;;
 nil)))
 (defun find-emacs-root-internal (path)
 ;;  (send-string-to-terminal (format "FINDING ROOT FOR %S\n" path))
 ;; first look for lisp/prim and lib-src; then just look for lib-src.
 ;; XEmacs can run (kind of) if the lisp directory is omitted, which
 ;; some people might want to do for space reasons.
 (or (find-emacs-root-internal-1 path t)
 (find-emacs-root-internal-1 path nil)
 (let* ((root (find-emacs-root-internal (concat invocation-directory
 						 invocation-name)))
 	 (lisp (and root
 		    (let ((f (expand-file-name "lisp" root)))
 		      (and (file-directory-p f) f))))
-	 (site-lisp (and root
+	 (site-lisp
-			 (or
+	  (and root
-			  (let ((f (expand-file-name "xemacs/site-lisp" root)))
+	       (or
-			    (and (file-directory-p f) f))
+		(let ((f (expand-file-name "xemacs/site-lisp" root)))
-			  (let ((f (expand-file-name "../xemacs/site-lisp"
+		  (and (file-directory-p f) f))
-						     root)))
+		(let ((f (expand-file-name "../xemacs/site-lisp" root)))
-			    (and (file-directory-p f) f))
+		  (and (file-directory-p f) f))
-			  ;; the next two are for --run-in-place
+		;; the next two are for --run-in-place
-			  (let ((f (expand-file-name "site-lisp" root)))
+		(let ((f (expand-file-name "site-lisp" root)))
-			    (and (file-directory-p f) f))
+		  (and (file-directory-p f) f))
-			  (let ((f (expand-file-name "lisp/site-lisp" root)))
+		(let ((f (expand-file-name "lisp/site-lisp" root)))
-			    (and (file-directory-p f) f))
+		  (and (file-directory-p f) f))
-			  )))
+		)))
-	 (lib-src (and root
+	 (lib-src
-		       (or
+	  (and root
-			(let ((f (expand-file-name
+	       (or
-				  (concat "lib-src/" system-configuration)
+		(let ((f (expand-file-name
-				  root)))
+			  (concat "lib-src/" system-configuration)
-			  (and (file-directory-p f) f))
+			  root)))
-			(let ((f (expand-file-name "lib-src" root)))
+		  (and (file-directory-p f) f))
-			  (and (file-directory-p f) f))
+		(let ((f (expand-file-name "lib-src" root)))
-			(let ((f (expand-file-name system-configuration root)))
+		  (and (file-directory-p f) f))
-			  (and (file-directory-p f) f)))))
+		(let ((f (expand-file-name system-configuration root)))
-	 (etc  (and root
+		  (and (file-directory-p f) f)))))
-		    (let ((f (expand-file-name "etc" root)))
+	 (etc
-		      (and (file-directory-p f) f))))
+	  (and root
-	 (info (and root
+	       (let ((f (expand-file-name "etc" root)))
-		    (let ((f (expand-file-name "info" root)))
+		 (and (file-directory-p f) f))))
-		      (and (file-directory-p f) (file-name-as-directory f)))))
+	 (info
-	 (lock (and root
+	  (and root
-		    (boundp 'lock-directory)
+	       (let ((f (expand-file-name "info" root)))
-		    (if (and lock-directory (file-directory-p lock-directory))
+		 (and (file-directory-p f) (file-name-as-directory f)))))
-			(file-name-as-directory lock-directory)
+	 (lock
-		      (or
+	  (and root
-		       (let ((f (expand-file-name "xemacs/lock" root)))
+	       (boundp 'lock-directory)
-			 (and (file-directory-p f)
+	       (if (and lock-directory (file-directory-p lock-directory))
-			      (file-name-as-directory f)))
+		   (file-name-as-directory lock-directory)
-		       (let ((f (expand-file-name "../xemacs/lock" root)))
+		 (or
-			 (and (file-directory-p f)
+		  (let ((f (expand-file-name "xemacs/lock" root)))
-			      (file-name-as-directory f)))
+		    (and (file-directory-p f)
-		       (let ((f (expand-file-name "lock" root)))
+			 (file-name-as-directory f)))
-			 (and (file-directory-p f)
+		  (let ((f (expand-file-name "../xemacs/lock" root)))
-			      (file-name-as-directory f)))
+		    (and (file-directory-p f)
-		       ;; if none of them exist, make the "guess" be
+			 (file-name-as-directory f)))
-		       ;; the one that set-default-load-path-warning
+		  (let ((f (expand-file-name "lock" root)))
-		       ;; will suggest.
+		    (and (file-directory-p f)
-		       (file-name-as-directory
+			 (file-name-as-directory f)))
-			(expand-file-name "../xemacs/lock" root))
+		  ;; if none of them exist, make the "guess" be
-		       )))))
+		  ;; the one that set-default-load-path-warning
+		  ;; will suggest.
-;; 1996/12/6 by MORIOKA Tomohiko <morioka@jaist.ac.jp>
+		  (file-name-as-directory
-;;	define `default-load-path' for file-detect.el
+		   (expand-file-name "../xemacs/lock" root))
-(setq default-load-path load-path)
+		  )))))
 ;; add site-lisp dir to load-path
-(if site-lisp
+(when site-lisp
-	(progn
+;; If the site-lisp dir isn't on the load-path, add it to the end.
-	  ;; If the site-lisp dir isn't on the load-path, add it to the end.
+(or (member site-lisp load-path)
-	  (or (member site-lisp load-path)
+	  (setq load-path (append load-path (list site-lisp))))
-	      (setq load-path (append load-path (list site-lisp))))
+;; Also add any direct subdirectories of the site-lisp directory
-	  ;; Also add any direct subdirectories of the site-lisp directory
+;; to the load-path.  But don't add dirs whose names begin
-	  ;; to the load-path.  But don't add dirs whose names begin
+;; with dot or hyphen.
-	  ;; with dot or hyphen.
+(let ((files (directory-files site-lisp nil "^[^-.]" nil 'dirs-only))
-	  (let ((files (directory-files site-lisp nil "^[^-.]" nil 'dirs-only))
+	    file)
-		file)
+	(while files
-	    (while files
+	  (setq file (car files))
-	      (setq file (car files))
+	  (if (and (not (member file '("RCS" "CVS" "SCCS")))
-	      (if (and (not (member file '("RCS" "CVS" "SCCS")))
+		   (setq file (expand-file-name file site-lisp))
-		       (setq file (expand-file-name file site-lisp))
+		   (not (member file load-path)))
-		       (not (member file load-path)))
+	      (setq load-path
-		  (setq load-path
+		    (nconc load-path
-			(nconc load-path
+			   (list (file-name-as-directory file)))))
-			       (list (file-name-as-directory file)))))
+	  (setq files (cdr files)))))
-	      (setq files (cdr files))))
-	  ))
 ;; add lisp dir to load-path
-(if lisp
+(when lisp
-	(progn
+;; If the lisp dir isn't on the load-path, add it to the end.
-	  ;; If the lisp dir isn't on the load-path, add it to the end.
+(or (member lisp load-path)
-	  (or (member lisp load-path)
+	  (setq load-path (append load-path (list lisp))))
-	      (setq load-path (append load-path (list lisp))))
+;; Also add any direct subdirectories of the lisp directory
-	  ;; Also add any direct subdirectories of the lisp directory
+;; to the load-path.  But don't add dirs whose names begin
-	  ;; to the load-path.  But don't add dirs whose names begin
+;; with dot or hyphen.
-	  ;; with dot or hyphen.
+(let ((files (directory-files lisp nil "^[^-.]" nil 'dirs-only))
-	  (let ((files (directory-files lisp nil "^[^-.]" nil 'dirs-only))
+	    file)
-		file)
+	(while files
-	    (while files
+	  (setq file (car files))
-	      (setq file (car files))
+	  (when (and (not (member file '("RCS" "CVS" "SCCS")))
-	      (if (and (not (member file '("RCS" "CVS" "SCCS")))
+		     (setq file (expand-file-name file lisp))
-		       (setq file (expand-file-name file lisp))
+		     (not (member file load-path)))
-		       (not (member file load-path)))
+	    (setq load-path
-		  (setq load-path
+		  (nconc load-path
-			(nconc load-path
+			 (list (file-name-as-directory file)))))
-			       (list (file-name-as-directory file)))))
+	  (setq files (cdr files)))))
-	      (setq files (cdr files))))))
-;; 1996/12/6 by MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;;	define `default-load-path' for file-detect.el
-(setq default-load-path
-	  (append default-load-path
-		  (if site-lisp
-		      (list site-lisp))
-		  (if lisp
-		      (list lisp)
-		    )
-		  ))
-;; 1997/03/06 by Jeff Miller <jmiller@bayserve.net>
-;; initialize 'site-directory'.  This is the site-lisp dir used by
-;; XEmacs
-(if site-lisp
-(setq site-directory (file-name-as-directory site-lisp))
-)
 ;; If running from the build directory, always prefer the exec-directory
-;; that is here over the one that came from paths.h.
+;; that is here over to the one that came from paths.h.
-(if (or (and (null exec-directory) lib-src)
+(when (or (and (null exec-directory) lib-src)
-	    (and (equal lib-src (expand-file-name "lib-src" root))
+	      (and (string= lib-src (expand-file-name "lib-src" root))
-		 (not (equal exec-directory lib-src))))
+		   (not (string= exec-directory lib-src))))
-	(setq exec-directory (file-name-as-directory lib-src)))
+(setq exec-directory (file-name-as-directory lib-src)))
-(if (or (and (null doc-directory) lib-src)
+(when (or (and (null doc-directory) lib-src)
-	    (and (equal lib-src (expand-file-name "lib-src" root))
+	      (and (string= lib-src (expand-file-name "lib-src" root))
-		 (not (equal doc-directory lib-src))))
+		   (not (string= doc-directory lib-src))))
-	(setq doc-directory (file-name-as-directory lib-src)))
+(setq doc-directory (file-name-as-directory lib-src)))
-(if exec-directory
+(when exec-directory
-	(or (member exec-directory exec-path)
+(or (member exec-directory exec-path)
-	    (setq exec-path (append exec-path (list exec-directory)))))
+	  (setq exec-path (append exec-path (list exec-directory)))))
-(if (or (and (null data-directory) etc)
+(when (or (and (null data-directory) etc)
-	    (and (equal etc (expand-file-name "etc" root))
+	      (and (string= etc (expand-file-name "etc" root))
-		 (not (equal data-directory etc))))
+		   (not (string= data-directory etc))))
-	(setq data-directory (file-name-as-directory etc)))
+(setq data-directory (file-name-as-directory etc)))
 ;; If `configure' specified an info dir, use it.
 (or (boundp 'Info-default-directory-list)
 	   (or (member configure-info-directory Info-default-directory-list)
 	       (setq Info-default-directory-list
 		     (append Info-default-directory-list
 			     (list configure-info-directory))))))
 ;; If we've guessed the info dir, use that (too).
-(if (and info (not (member info Info-default-directory-list)))
+(when (and info (not (member info Info-default-directory-list)))
-	(setq Info-default-directory-list
+(setq Info-default-directory-list
-	      (append Info-default-directory-list (list info))))
+	    (append Info-default-directory-list (list info))))
 ;; Default the lock dir to being a sibling of the data-directory.
 ;; If superlock isn't set, or is set to a file in a nonexistent
 ;; directory, derive it from the lock dir.
-(if (boundp 'lock-directory)
+(when (boundp 'lock-directory)
-	(progn
+(setq lock-directory lock)
-	  (setq lock-directory lock)
+(cond ((null lock-directory)
-	  (cond ((null lock-directory)
+	     (setq superlock-file nil))
-		 (setq superlock-file nil))
+	    ((or (null superlock-file)
-		((or (null superlock-file)
+		 (not (file-directory-p
-		     (not (file-directory-p
+		       (file-name-directory superlock-file))))
-			   (file-name-directory superlock-file))))
+	     (setq superlock-file
-		 (setq superlock-file
+		   (expand-file-name "!!!SuperLock!!!"
-		       (expand-file-name "!!!SuperLock!!!"
+				     lock-directory)))))
-					 lock-directory))))))
 (set-default-load-path-warning)))
 (defun set-default-load-path-warning ()
 (let ((lock (if (boundp 'lock-directory) lock-directory 't))
 	warnings message guess)
-(if (and (stringp lock) (not (file-directory-p lock)))
+(when (and (stringp lock) (not (file-directory-p lock)))
-	(setq lock nil))
+(setq lock nil))
 (cond
 ((not (and exec-directory data-directory doc-directory load-path lock))
 (save-excursion
 	(set-buffer (get-buffer-create " *warning-tmp*"))
 	(erase-buffer)
 	(buffer-disable-undo (current-buffer))
-	(if (null lock)
+	(when (null lock)           (push "lock-directory" warnings))
-	    (setq warnings (cons "lock-directory" warnings)))
+	(when (null exec-directory) (push "exec-directory" warnings))
-	(if (null exec-directory)
+	(when (null data-directory) (push "data-directory" warnings))
-	    (setq warnings (cons "exec-directory" warnings)))
+	(when (null doc-directory)  (push "doc-directory"  warnings))
-	(if (null data-directory)
+	(when (null load-path)      (push "load-path"      warnings))
-	    (setq warnings (cons "data-directory" warnings)))
-	(if (null doc-directory)
-	    (setq warnings (cons "doc-directory" warnings)))
-	(if (null load-path)
-	    (setq warnings (cons "load-path" warnings)))
 	(cond ((cdr (cdr warnings))
 	       (setq message (apply 'format "%s, %s, and %s" warnings)))
 	      ((cdr warnings)
 	       (setq message (apply 'format "%s and %s" warnings)))
 	      (t (setq message (format "variable %s" (car warnings)))))
 			doc-directory
 			(car load-path)
 			(and (string-match "/[^/]+\\'" invocation-directory)
 			     (substring invocation-directory 0
 					(match-beginning 0)))))
-	(if (and guess
+	(when (and guess
-		 (or
+		   (or
-		  ;; parent of a terminal bin/<configuration> pair (hack hack).
+		    ;; parent of a terminal bin/<configuration> pair (hack hack).
-		  (string-match (concat "/bin/"
+		    (string-match (concat "/bin/"
-					(regexp-quote system-configuration)
+					  (regexp-quote system-configuration)
-					"/?\\'")
+					  "/?\\'")
-				guess)
+				  guess)
-		  ;; parent of terminal src, lib-src, etc, or lisp dir.
+		    ;; parent of terminal src, lib-src, etc, or lisp dir.
-		  (string-match
+		    (string-match
-		   "/\\(bin\\|src\\|lib-src\\|etc\\|lisp\\)[^/]*/?\\'"
+		     "/\\(bin\\|src\\|lib-src\\|etc\\|lisp\\)[^/]*/?\\'"
-				guess)))
+		     guess)))
-	    (setq guess (substring guess 0 (match-beginning 0))))
+	  (setq guess (substring guess 0 (match-beginning 0))))
 	;; If neither the exec nor lisp dirs are around, then "guess" that
 	;; the new configure-style lib dir should be used.  Otherwise, if
 	;; only one of them appears to be missing, or it's just lock,
 	;; then guess it to be a sibling of whatever already exists.
-	(if (and (null exec-directory) (null load-path))
+	(when (and (null exec-directory) (null load-path))
-	    (setq guess (expand-file-name (startup-make-version-dir) guess)))
+	  (setq guess (expand-file-name (startup-make-version-dir) guess)))
-	(if (or (null exec-directory) (null load-path))
+	(when (or (null exec-directory) (null load-path))
+	  (insert
+	   "\n\nWithout both exec-directory and load-path, XEmacs will "
+	   "be very broken.  "))
+	(when (and (null exec-directory) guess)
+	  (insert
+	   "Consider making a symbolic link from "
+	   (expand-file-name system-configuration guess)
+	   " to wherever the appropriate XEmacs exec-directory "
+	   "directory is"))
+	(when (and (null data-directory) guess)
+	  (insert
+	   (if exec-directory
+	       "\n\nConsider making a symbolic link " ", and ")
+	   "from "
+	   (expand-file-name "etc" (if load-path
+				       (file-name-directory
+					(directory-file-name
+					 (car load-path)))
+				     guess))
+	   " to wherever the appropriate XEmacs data-directory is"))
+	(when (and (null load-path) guess)
+	  (insert
+	   (if (and exec-directory data-directory)
+	       "Consider making a symbolic link "
+	     ", and ")
+	   "from "
+	   (expand-file-name "lisp" guess)
+	   " to wherever the appropriate XEmacs lisp library is"))
+	(insert ".")
+	(when (null lock)
+	  (insert
+	   "\n\nWithout lock-directory set, file locking won't work.  ")
+	  (when guess
 	    (insert
-	     "\n\nWithout both exec-directory and load-path, XEmacs will "
+	     "Consider creating "
-	     "be very broken.  "))
+	     (expand-file-name "../xemacs/lock"
-	(if (and (null exec-directory) guess)
+			       (or (find-emacs-root-internal
-	    (insert
+				    (concat invocation-directory
-	     "Consider making a symbolic link from "
+					    invocation-name))
-	     (expand-file-name system-configuration guess)
+				   guess))
-	     " to wherever the appropriate XEmacs exec-directory "
+	     " as a directory or symbolic link for use as the lock "
-	     "directory is"))
+	     "directory.  (This directory must be globally writable.)"
-	(if (and (null data-directory) guess)
+	     )))
-	    (insert
-	     (if exec-directory
+	(when (fboundp 'fill-region)
-		 "\n\nConsider making a symbolic link " ", and ")
+	  ;; Might not be bound in the cold load environment...
-	     "from "
+	  (let ((fill-column 76))
-	     (expand-file-name "etc" (if load-path
+	    (fill-region (point-min) (point-max))))
-					 (file-name-directory
-					  (directory-file-name
-					   (car load-path)))
-				       guess))
-	     " to wherever the appropriate XEmacs data-directory is"))
-	(if (and (null load-path) guess)
-	    (insert
-	     (if (and exec-directory data-directory)
-		 "Consider making a symbolic link "
-	       ", and ")
-	     "from "
-	     (expand-file-name "lisp" guess)
-	     " to wherever the appropriate XEmacs lisp library is"))
-	(insert ".")
-	(if (null lock)
-	    (progn
-	      (insert
-	       "\n\nWithout lock-directory set, file locking won't work.  ")
-	      (if guess
-		  (insert
-		   "Consider creating "
-		   (expand-file-name "../xemacs/lock"
-				     (or (find-emacs-root-internal
-					  (concat invocation-directory
-						  invocation-name))
-					 guess))
-		   " as a directory or symbolic link for use as the lock "
-		   "directory.  (This directory must be globally writable.)"
-		   ))))
-(if (fboundp 'fill-region)
-;; Might not be bound in the cold load environment...
-	    (let ((fill-column 76))
-	      (fill-region (point-min) (point-max))))
 	(goto-char (point-min))
 	(princ "\nWARNING:\n" 'external-debugging-output)
 	(princ (buffer-string) 'external-debugging-output)
 	(erase-buffer)
 	t)))))
 ;;; startup.el ends here

Mercurial > hg > xemacs-beta

comparison lisp/prim/startup.el @ 70:131b0175ea99 r20-0b30