(defvar command-line-processed nil "t once command line has been processed")
(defconst startup-message-timeout 12000) ; More or less disable the timeout
-(defconst splash-frame-timeout 7) ; interval between splash frame elements
(defconst inhibit-startup-message nil
"*Non-nil inhibits the initial startup message.
(defvar emacs-roots nil
"List of plausible roots of the XEmacs hierarchy.")
-(defvar user-init-directory-base ".xemacs"
- "Base of directory where user-installed init files may go.")
+(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.
-(defvar user-init-file-base (cond
- ((eq system-type 'ms-dos) "_emacs")
- (t ".emacs"))
- "Base of init file.")
+In either of the latter cases, `(concat \"~\" init-file-user \"/\")'
+evaluates to the name of the directory in which the `.emacs' file was
+searched for.
-(defvar user-init-directory
- (file-name-as-directory
- (paths-construct-path (list "~" user-init-directory-base)))
- "Directory where user-installed init files may go.")
-
-(defvar load-user-init-file-p t
- "Non-nil if XEmacs should load the user's init file.")
+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
(princ (concat "\n" (emacs-version) "\n\n"))
(princ
(if (featurep 'x)
- (concat "When creating a window on an X display, "
- (emacs-name)
- " accepts all standard X Toolkit
-command line options plus the following:
- -iconname <title> Use title as the icon name.
- -mc <color> Use color as the mouse color.
- -cr <color> Use color as the text-cursor foregound color.
- -private Install a private colormap.
-
-In addition, the")
+ (concat (emacs-name)
+ " accepts all standard X Toolkit command line options.\n"
+ "In addition, the")
"The"))
(princ " following options are accepted:
+
-t <device> Use TTY <device> instead of the terminal for input
and output. This implies the -nw option.
-nw Inhibit the use of any window-system-specific
startup. Also implies `-vanilla'.
-vanilla Equivalent to -q -no-site-file -no-early-packages.
-q Same as -no-init-file.
- -user-init-file <file> Use <file> as init file.
- -user-init-directory <directory> use <directory> as init directory.
-user <user> Load user's init file instead of your own.
- Equivalent to -user-init-file ~<user>/.emacs
- -user-init-directory ~<user>/.xemacs/
-u <user> Same as -user.\n")
(let ((l command-switch-alist)
(insert (lambda (&rest x)
(message "Back to top level.")
(setq command-line-processed t)
;; Canonicalize HOME (PWD is canonicalized by init_buffer in buffer.c)
- (let ((value (user-home-directory)))
- (if (and value
- (< (length value) (length default-directory))
- (equal (file-attributes default-directory)
- (file-attributes value)))
- (setq default-directory (file-name-as-directory value))))
+ (unless (eq system-type 'vax-vms)
+ (let ((value (user-home-directory)))
+ (if (and value
+ (< (length value) (length default-directory))
+ (equal (file-attributes default-directory)
+ (file-attributes value)))
+ (setq default-directory (file-name-as-directory value)))))
(setq default-directory (abbreviate-file-name default-directory))
(initialize-xemacs-paths)
(if (null emacs-roots)
(startup-find-roots-warning)
(startup-setup-paths emacs-roots
- user-init-directory
inhibit-early-packages
inhibit-site-lisp
debug-paths))
(if (not inhibit-autoloads)
(progn
- (if (not inhibit-early-packages)
- (packages-load-package-auto-autoloads early-package-load-path))
+ (packages-load-package-auto-autoloads last-package-load-path)
(packages-load-package-auto-autoloads late-package-load-path)
- (packages-load-package-auto-autoloads last-package-load-path)))
+ (if (not inhibit-early-packages)
+ (packages-load-package-auto-autoloads early-package-load-path))))
(unwind-protect
(command-line)
;; (standard-display-european t)
;; (require 'iso-syntax)))
- (setq load-user-init-file-p (not (noninteractive)))
+ ;; Figure out which user's init file to load,
+ ;; either from the environment or from the options.
+ (setq init-file-user (if (noninteractive) nil (user-login-name)))
+ ;; If user has not done su, use current $HOME to find .emacs.
+ (and init-file-user (string= init-file-user (user-real-login-name))
+ (setq init-file-user ""))
;; Allow (at least) these arguments anywhere in the command line
(let ((new-args nil)
(cond
((or (string= arg "-q")
(string= arg "-no-init-file"))
- (setq load-user-init-file-p nil))
+ (setq init-file-user nil))
((string= arg "-no-site-file")
(setq site-start-file nil))
((or (string= arg "-no-early-packages")
;; Some work on this one already done in emacs.c.
(string= arg "-no-autoloads")
(string= arg "--no-autoloads"))
- (setq load-user-init-file-p nil
+ (setq init-file-user nil
site-start-file nil))
- ((string= arg "-user-init-file")
- (setq user-init-file (pop args)))
- ((string= arg "-user-init-directory")
- (setq user-init-directory (file-name-as-directory (pop args))))
((or (string= arg "-u")
- (string= arg "-user"))
- (let* ((user (pop args))
- (home-user (concat "~" user)))
- (setq user-init-file
- (paths-construct-path (list home-user user-init-file-base)))
- (setq user-init-directory
- (file-name-as-directory
- (paths-construct-path (list home-user user-init-directory-base))))))
+ (string= arg "-user"))
+ (setq init-file-user (pop args)))
((string= arg "-debug-init")
(setq init-file-debug t))
((string= arg "-unmapped")
(while args
(push (pop args) new-args)))
(t (push arg new-args))))
-
- (setq init-file-user (and load-user-init-file-p ""))
-
+
(nreverse new-args)))
(defconst initial-scratch-message "\
(setq term (substring term 0 hyphend))
(setq term nil))))))
-(defun load-user-init-file ()
+(defconst user-init-directory "/.xemacs/"
+ "Directory where user-installed packages may go.")
+(define-obsolete-variable-alias
+ 'emacs-user-extension-dir
+ 'user-init-directory)
+
+(defun load-user-init-file (init-file-user)
"This function actually reads the init file, .emacs."
- (if (not user-init-file)
- (setq user-init-file
- (paths-construct-path (list "~" user-init-file-base))))
- (load user-init-file t t t)
- (unless 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))))
+ (when init-file-user
+;; purge references to init.el and options.el
+;; convert these to use paths-construct-path for eventual migration to init.el
+;; needs to be converted when idiom for constructing "~user" paths is created
+; (setq user-init-file
+; (paths-construct-path (list (concat "~" init-file-user)
+; user-init-directory
+; "init.el")))
+; (unless (file-exists-p (expand-file-name user-init-file))
+ (setq user-init-file
+ (paths-construct-path (list (concat "~" init-file-user)
+ (cond
+ ((eq system-type 'ms-dos) "_emacs")
+ (t ".emacs")))))
+; )
+ (load user-init-file t t t)
+;; This should not be loaded since custom stuff currently goes into .emacs
+; (let ((default-custom-file
+; (paths-construct-path (list (concat "~" init-file-user)
+; user-init-directory
+; "options.el")))
+; (when (string= custom-file default-custom-file)
+; (load default-custom-file t t)))
+ (unless 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)))))
;;; Load user's init file and default ones.
(defun load-init-file ()
(debug-on-error-initial
(if (eq init-file-debug t) 'startup init-file-debug)))
(let ((debug-on-error debug-on-error-initial))
- (if (and load-user-init-file-p init-file-debug)
+ (if init-file-debug
;; Do this without a condition-case if the user wants to debug.
- (load-user-init-file)
+ (load-user-init-file init-file-user)
(condition-case error
(progn
- (if load-user-init-file-p
- (load-user-init-file))
+ (load-user-init-file init-file-user)
(setq init-file-had-error nil))
(error
(message "Error in init file: %s" (error-message-string error))
(display-warning 'initialization
(format "\
-An error has occurred while loading %s:
+An error has occured while loading %s:
%s
(when (string= (buffer-name) "*scratch*")
(unless (or inhibit-startup-message
(input-pending-p))
- (let (tmout circ-tmout)
+ (let ((timeout nil))
(unwind-protect
;; Guts of with-timeout
- (catch 'tmout
- (setq tmout (add-timeout startup-message-timeout
- (lambda (ignore)
- (condition-case nil
- (throw 'tmout t)
- (error nil)))
- nil))
- (setq circ-tmout (display-splash-frame))
+ (catch 'timeout
+ (setq timeout (add-timeout startup-message-timeout
+ (lambda (ignore)
+ (condition-case nil
+ (throw 'timeout t)
+ (error nil)))
+ nil))
+ (startup-splash-frame)
(or nil;; (pos-visible-in-window-p (point-min))
(goto-char (point-min)))
(sit-for 0)
(setq unread-command-event (next-command-event)))
- (when tmout (disable-timeout tmout))
- (when circ-tmout (disable-timeout circ-tmout)))))
+ (when timeout (disable-timeout timeout)))))
(with-current-buffer (get-buffer "*scratch*")
;; In case the XEmacs server has already selected
;; another buffer, erase the one our message is in.
(symbol-name e)))
(defun splash-frame-present-hack (e v)
- ;; (set-extent-property e 'mouse-face 'highlight)
- ;; (set-extent-property e 'keymap
- ;; startup-presentation-hack-keymap)
- ;; (set-extent-property e 'startup-presentation-hack v)
- ;; (set-extent-property e 'help-echo
- ;; 'startup-presentation-hack-help)
+ ;; (set-extent-property e 'mouse-face 'highlight)
+ ;; (set-extent-property e 'keymap
+ ;; startup-presentation-hack-keymap)
+ ;; (set-extent-property e 'startup-presentation-hack v)
+ ;; (set-extent-property e 'help-echo
+ ;; 'startup-presentation-hack-help))
)
(defun splash-hack-version-string ()
(+ left-margin
(round (/ (/ (- fill-area-width glyph-pixwidth) 2) avg-pixwidth)))))
-(defun splash-frame-body ()
- `[((face (blue bold underline)
- "\nDistribution, copying license, warranty:\n\n")
- "Please visit the XEmacs website at http://www.xemacs.org !\n\n"
- ,@(if (featurep 'sparcworks)
- `( "\
+(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) 1990-1994 Lucid, Inc.
+Copyright (C) 1993-1997 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\".\n"
- ,@(let ((lang (or (getenv "LC_ALL") (getenv "LC_MESSAGES")
- (getenv "LANG"))))
- (if (and
- (not (featurep 'mule)) ;; Already got mule?
- ;; No Mule support on tty's yet
- (not (eq 'tty (console-type)))
- lang ;; Non-English locale?
- (not (string= lang "C"))
- (not (string-match "^en" lang))
- ;; Comes with Sun WorkShop
- (locate-file "xemacs-mule" exec-path))
- '( "\
+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 "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= 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
XEmacs, by either running the command `xemacs-mule', or by using the X resource
-`ESERVE*defaultXEmacsPath: xemacs-mule' when starting XEmacs from Sun WorkShop.
-\n")))))
- ((key describe-no-warranty)
- ": "(face (red bold) "XEmacs comes with ABSOLUTELY NO WARRANTY\n"))
- ((key describe-copying)
- ": conditions to give out copies of XEmacs\n")
- ((key describe-distribution)
- ": how to get the latest version\n")
- "\n--\n"
- (face italic "\
-Copyright (C) 1985-1999 Free Software Foundation, Inc.
-Copyright (C) 1990-1994 Lucid, Inc.
-Copyright (C) 1993-1997 Sun Microsystems, Inc. All Rights Reserved.
-Copyright (C) 1994-1996 Board of Trustees, University of Illinois
-Copyright (C) 1995-1996 Ben Wing\n"))
+`ESERVE*defaultXEmacsPath: xemacs-mule' when starting XEmacs from Sun WorkShop.\n\n"))))
+
+ '("XEmacs comes with ABSOLUTELY NO WARRANTY; type "
+ (key describe-no-warranty) " for full details.\n"))
- ((face (blue bold underline) "\nInformation, on-line help:\n\n")
- "XEmacs comes with plenty of documentation...\n\n"
- ,@(if (string-match "beta" emacs-version)
- `((key describe-beta)
- ": " (face (red bold)
- "This is an Experimental version of XEmacs.\n"))
- `( "\n"))
- ((key xemacs-local-faq)
- ": read the XEmacs FAQ (a " (face underline "capital") " F!)\n")
- ((key help-with-tutorial)
- ": read the XEmacs tutorial (also available through the "
- (face bold "Help") " menu)\n")
- ((key help-command)
- ": get help on using XEmacs (also available through the "
- (face bold "Help") " menu)\n")
- ((key info) ": read the on-line documentation\n\n")
- ((key describe-project) ": read about the GNU project\n")
- ((key about-xemacs) ": see who's developing XEmacs\n"))
-
- ((face (blue bold underline) "\nUseful stuff:\n\n")
- "Things that you should know rather quickly...\n\n"
- ((key find-file) ": visit a file\n")
- ((key save-buffer) ": save changes\n")
- ((key advertised-undo) ": undo changes\n")
- ((key save-buffers-kill-emacs) ": exit XEmacs\n"))
- ])
+ "You may give out copies of XEmacs; type "
+ (key describe-copying) " to see the conditions.\n"
+ "Type " (key describe-distribution)
+ " for information on getting the latest version.\n\n"
+
+ "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"
+ (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!].\)"))))
;; I really hate global variables, oh well.
;(defvar xemacs-startup-logo-function nil
; "If non-nil, function called to provide the startup logo.
;This function should return an initialized glyph if it is used.")
-;; This will hopefully go away when gettext is functionnal.
-(defconst splash-frame-static-body
- `(,(emacs-version) "\n\n"
- (face italic "`C-' means the control key,`M-' means the meta key\n\n")))
-
-
-(defun circulate-splash-frame-elements (client-data)
- (with-current-buffer (aref client-data 2)
- (let ((buffer-read-only nil)
- (elements (aref client-data 3))
- (indice (aref client-data 0)))
- (goto-char (aref client-data 1))
- (delete-region (point) (point-max))
- (splash-frame-present (aref elements indice))
- (set-buffer-modified-p nil)
- (aset client-data 0
- (if (= indice (- (length elements) 1))
- 0
- (1+ indice )))
- )))
-
-;; ### This function now returns the (possibly nil) timeout circulating the
-;; splash-frame elements
-(defun display-splash-frame ()
- (let ((logo xemacs-logo)
- (buffer-read-only nil)
+(defun startup-splash-frame ()
+ (let ((p (point))
+; (logo (cond (xemacs-startup-logo-function
+; (funcall xemacs-startup-logo-function))
+; (t xemacs-logo)))
+ (logo xemacs-logo)
(cramped-p (eq 'tty (console-type))))
(unless cramped-p (insert "\n"))
(indent-to (startup-center-spaces logo))
(set-extent-begin-glyph (make-extent (point) (point)) logo)
- ;;(splash-frame-present-hack (make-extent p (point)) 'about-xemacs))
- (insert "\n\n")
- (splash-frame-present splash-frame-static-body)
- (splash-hack-version-string)
- (goto-char (point-max))
- (let* ((after-change-functions nil) ; no font-lock, thank you
- (elements (splash-frame-body))
- (client-data `[ 1 ,(point) ,(current-buffer) ,elements ])
- tmout)
- (if (listp elements) ;; A single element to display
- (splash-frame-present (splash-frame-body))
- ;; several elements to rotate
- (splash-frame-present (aref elements 0))
- (setq tmout (add-timeout splash-frame-timeout
- 'circulate-splash-frame-elements
- client-data splash-frame-timeout)))
- (set-buffer-modified-p nil)
- tmout)))
+ (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
+ (dolist (l (startup-splash-frame-body))
+ (splash-frame-present l)))
+ (splash-hack-version-string)
+ (set-buffer-modified-p nil))
;; (let ((present-file
;; #'(lambda (f)
;; don't let /tmp_mnt/... get into the load-path or exec-path.
(abbreviate-file-name invocation-directory)))
-(defun startup-setup-paths (roots user-init-directory
- &optional
+(defun startup-setup-paths (roots &optional
inhibit-early-packages inhibit-site-lisp
debug-paths)
"Setup all the various paths.
early))
(setq late-packages late)
(setq last-packages last))
- (packages-find-packages
- roots
- (packages-compute-package-locations user-init-directory)))
+ (packages-find-packages roots))
(setq early-package-load-path (packages-find-package-load-path early-packages))
(setq late-package-load-path (packages-find-package-load-path late-packages))