;; 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
+;; along with XEmacs; see the file COPYING. If not, write to the
;; Free Software Foundation, 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;; This file is dumped with XEmacs.
-;; -batch, -t, and -nw are processed by main() in emacs.c and are
+;; -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,
(defvar user-init-directory-base ".xemacs"
"Base of directory where user-installed init files may go.")
-(defvar user-init-file-base (cond
- ((eq system-type 'ms-dos) "_emacs")
- (t ".emacs"))
- "Base of init file.")
-
(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 user-init-file-base "init.el"
+ "Default name of the user init file if uncompiled.
+This should be used for migration purposes only.")
+
+(defvar user-init-file-base-list '("init.elc" "init.el")
+ "List of allowed init files in the user's init directory.
+The first one found takes precedence.")
+
+(defvar user-home-init-file-base-list
+ (append '(".emacs.elc" ".emacs.el" ".emacs")
+ (and (eq system-type 'windows-nt)
+ '("_emacs.elc" "_emacs.el" "_emacs")))
+ "List of allowed init files in the user's home directory.
+The first one found takes precedence.")
+
+(defvar load-home-init-file nil
+ "Non-nil if XEmacs should load the init file from the home directory.
+Otherwise, XEmacs will offer migration to the init directory.")
+
(defvar load-user-init-file-p t
"Non-nil if XEmacs should load the user's init file.")
;;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.")
+(defcustom mail-host-address nil
+ "*Name of this machine, for purposes of naming users."
+ :type 'string
+ :group 'mail)
-(defvar user-mail-address nil
+(defcustom 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'.")
+after your init file is read, in case it sets `mail-host-address'."
+ :type 'string
+ :group 'mail)
(defvar auto-save-list-file-prefix "~/.saves-"
"Prefix for generating auto-save-list-file-name.
(princ "\n\n" stream)))
(when (not suppress-early-error-handler-backtrace)
(backtrace stream t)))
+ (if (fboundp 'mswindows-message-box)
+ (mswindows-message-box "Initialization error"))
(kill-emacs -1))
-(defvar lock-directory)
-(defvar superlock-file)
-
(defun normal-top-level ()
(if command-line-processed
(message "Back to top level.")
(setq emacs-roots (paths-find-emacs-roots invocation-directory
invocation-name))
-
+
(if debug-paths
(princ (format "emacs-roots:\n%S\n" emacs-roots)
'external-debugging-output))
-
+
(if (null emacs-roots)
(startup-find-roots-warning)
(startup-setup-paths emacs-roots
lisp-directory)
(load (expand-file-name (file-name-sans-extension autoload-file-name)
lisp-directory) nil t))
-
+
(if (not inhibit-autoloads)
(progn
(if (not inhibit-early-packages)
(when window-setup-hook
(run-hooks 'window-setup-hook))
(setq window-setup-hook nil))
+
+ (if load-user-init-file-p
+ (maybe-migrate-user-init-file))
;;####FSFmacs junk
;; (or menubar-bindings-done
;; (precompute-menubar-bindings))
;; (and (not (equal string "")) string)))))
;; (and ctype
;; (string-match iso-8859-1-locale-regexp ctype)))
- ;; (progn
+ ;; (progn
;; (standard-display-european t)
;; (require 'iso-syntax)))
(string= arg "-user"))
(let* ((user (pop args))
(home-user (concat "~" user)))
+ (setq user-init-directory (file-name-as-directory
+ (paths-construct-path
+ (list home-user user-init-directory-base))))
(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))))))
+ (find-user-init-file user-init-directory home-user))
+ (setq custom-file
+ (make-custom-file-name user-init-file))))
((string= arg "-debug-init")
(setq init-file-debug t))
((string= arg "-unmapped")
;; and deletes the stdio device.
(frame-initialize))
+ ;; Reinitialize faces if necessary. This function changes face if
+ ;; it is created during auto-autoloads loading. Otherwise, it
+ ;; does nothing.
+ (startup-initialize-custom-faces)
+
;;
;; We have normality, I repeat, we have normality. Anything you still
;; can't cope with is therefore your own problem. (And we don't need
;;; Load init files.
(load-init-file)
-
+
(with-current-buffer (get-buffer "*scratch*")
(erase-buffer)
;; (insert initial-scratch-message)
;; If -batch, terminate after processing the command options.
(when (noninteractive) (kill-emacs t))))
-(defun load-terminal-library ()
+(defun load-terminal-library ()
(when term-file-prefix
(let ((term (getenv "TERM"))
hyphend)
(setq term (substring term 0 hyphend))
(setq term nil))))))
+(defun find-user-init-directory-init-file (&optional init-directory)
+ "Determine the user's init file if in the init directory."
+ (let ((init-directory (or init-directory user-init-directory)))
+ (catch 'found
+ (dolist (file user-init-file-base-list)
+ (let ((expanded (expand-file-name file init-directory)))
+ (when (file-readable-p expanded)
+ (throw 'found expanded)))))))
+
+(defun find-user-home-directory-init-file (&optional home-directory)
+ "Determine the user's init file if in the home directory."
+ (let ((home-directory (or home-directory "~")))
+ (catch 'found
+ (dolist (file user-home-init-file-base-list)
+ (let ((expanded (expand-file-name file home-directory)))
+ (when (file-readable-p expanded)
+ (throw 'found expanded))))
+ nil)))
+
+(defun find-user-init-file (&optional init-directory home-directory)
+ "Determine the user's init file."
+ (if load-home-init-file
+ (find-user-home-directory-init-file home-directory)
+ (or (find-user-init-directory-init-file init-directory)
+ (find-user-home-directory-init-file home-directory))))
+
+(defun maybe-migrate-user-init-file ()
+ "Ask user if she wants to migrate the init file(s) to new location."
+ (if (and (not load-home-init-file)
+ (not (find-user-init-directory-init-file user-init-directory))
+ (stringp user-init-file)
+ (file-readable-p user-init-file))
+ (if (with-output-to-temp-buffer (help-buffer-name nil)
+ (progn
+ (princ "XEmacs recommends that the initialization code in
+")
+ (princ user-init-file)
+ (princ "
+be migrated to the ")
+ (princ user-init-directory)
+ (princ " directory. XEmacs can
+perform the migration automatically.
+
+After the migration, init.el/init.elc holds user-written
+initialization code. Moreover the customize settings will be in
+custom.el.
+
+If you choose not to do this now, XEmacs will not ask you this
+question in the future. However, you can still make XEmacs
+perform the migration at any time with M-x migrate-user-init-file.")
+ (show-temp-buffer-in-current-frame standard-output)
+ (yes-or-no-p-minibuf (concat "Migrate init file to "
+ user-init-directory
+ "? "))))
+ (migrate-user-init-file)
+ (customize-save-variable 'load-home-init-file t))))
+
+(defun migrate-user-init-file ()
+ "Migrate the init file from the home directory."
+ (interactive)
+ (if (not (file-exists-p user-init-directory))
+ (progn
+ (message "Creating %s directory..." user-init-directory)
+ (make-directory user-init-directory)))
+ (message "Migrating custom file...")
+ (custom-migrate-custom-file (make-custom-file-name user-init-file
+ 'force-new))
+ (message "Moving init file...")
+ (rename-file user-init-file
+ (expand-file-name user-init-file-base
+ user-init-directory))
+ (message "Migration done."))
+
(defun load-user-init-file ()
- "This function actually reads the init file, .emacs."
+ "This function actually reads the init file."
(if (not user-init-file)
(setq user-init-file
- (paths-construct-path (list "~" user-init-file-base))))
- (load user-init-file t t t)
+ (find-user-init-file user-init-directory)))
+ (if (and user-init-file
+ (file-readable-p user-init-file))
+ (load user-init-file t t t))
+ (if (not custom-file)
+ (setq custom-file (make-custom-file-name user-init-file)))
+ (if (and custom-file
+ (or (not user-init-file)
+ (not (string= custom-file user-init-file)))
+ (file-readable-p custom-file))
+ (load custom-file t t t))
(unless inhibit-default-init
(let ((inhibit-startup-message nil))
;; Users are supposed to be told their rights.
(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)
- ;; Do this without a condition-case if the user wants to debug.
- (load-user-init-file)
+ (progn
+ ;; Do this without a condition-case if the user wants to debug.
+ (load-user-init-file))
(condition-case error
(progn
(if load-user-init-file-p
(file-count 0)
(line nil)
(end-of-options nil)
- first-file-buffer file-p arg tem)
+ file-p arg tem)
(while command-line-args-left
(setq arg (pop command-line-args-left))
(cond
(setq end-of-options t))
(t
(setq file-p t)))
-
+
(when file-p
(setq file-p nil)
(incf file-count)
(setq arg (expand-file-name arg dir))
(cond
- ((= file-count 1) (setq first-file-buffer
- (progn (find-file arg) (current-buffer))))
+ ((= file-count 1)
+ (find-file arg))
(noninteractive (find-file arg))
(t (find-file-other-window arg)))
(when line
(setq e (read-key-sequence
(let ((p (keymap-prompt map t)))
(cond ((symbolp map)
- (if p
+ (if p
(format "%s %s " map p)
(format "%s " map)))
(p)
(defun startup-center-spaces (glyph)
;; Return the number of spaces to insert in order to center
;; the given glyph (may be a string or a pixmap).
- ;; Assume spaces are as wide as avg-pixwidth.
+ ;; Assume spaces are as wide as avg-pixwidth.
;; Won't be quite right for proportional fonts, but it's the best we can do.
;; Maybe the new redisplay will export something a glyph-width function.
;;; #### Yes, there is a glyph-width function but it isn't quite what
;; This function is used in about.el too.
(let* ((avg-pixwidth (round (/ (frame-pixel-width) (frame-width))))
(fill-area-width (* avg-pixwidth (- fill-column left-margin)))
- (glyph-pixwidth (cond ((stringp glyph)
+ (glyph-pixwidth (cond ((stringp glyph)
(* avg-pixwidth (length glyph)))
;; #### the pixmap option should be removed
;;((pixmapp glyph)
`( "\
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")
+ ,@(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)))
+ (not (eq 'tty (console-type)))
lang ;; Non-English locale?
(not (string= lang "C"))
(not (string-match "^en" lang))
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)
+ ((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")
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"))
-
+
((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)
+ `((key describe-beta)
": " (face (red bold)
"This is an Experimental version of XEmacs.\n"))
`( "\n"))
; "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.
+;; This will hopefully go away when gettext is functional.
(defconst splash-frame-static-body
`(,(emacs-version) "\n\n"
(face italic "`C-' means the control key,`M-' means the meta key\n\n")))
(1+ indice )))
)))
-;; ### This function now returns the (possibly nil) timeout circulating the
+;; #### This function now returns the (possibly nil) timeout circulating the
;; splash-frame elements
(defun display-splash-frame ()
(let ((logo xemacs-logo)
(paths-construct-info-path roots
early-packages late-packages last-packages))
-
+
(if debug-paths
(princ (format "Info-directory-list:\n%S\n" Info-directory-list)
'external-debugging-output))
- (if (boundp 'lock-directory)
- (progn
- (setq lock-directory (paths-find-lock-directory roots))
- (setq superlock-file (paths-find-superlock-file lock-directory))
-
- (if debug-paths
- (progn
- (princ (format "lock-directory:\n%S\n" lock-directory)
- 'external-debugging-output)
- (princ (format "superlock-file:\n%S\n" superlock-file)
- 'external-debugging-output)))))
-
(setq exec-directory (paths-find-exec-directory roots))
(if debug-paths
(if debug-paths
(princ (format "exec-path:\n%S\n" exec-path)
'external-debugging-output))
-
+
(setq doc-directory (paths-find-doc-directory roots))
(if debug-paths
(princ (buffer-string) 'external-debugging-output)))
(defun startup-setup-paths-warning ()
- (let ((lock (if (boundp 'lock-directory) lock-directory 't))
- (warnings '()))
- (if (and (stringp lock) (null (file-directory-p lock)))
- (setq lock nil))
+ (let ((warnings '()))
(cond
((null (and lisp-directory exec-directory data-directory doc-directory
- load-path
- lock))
+ load-path))
(save-excursion
(set-buffer (get-buffer-create " *warning-tmp*"))
(erase-buffer)
(buffer-disable-undo (current-buffer))
(if (null lisp-directory) (push "lisp-directory" warnings))
- (if (null lock) (push "lock-directory" warnings))
(if (null exec-directory) (push "exec-directory" warnings))
(if (null data-directory) (push "data-directory" warnings))
(if (null doc-directory) (push "doc-directory" warnings))
projects / chise / xemacs-chise.git- / blobdiff