;; Copyright (C) 1985-1986, 1990, 1992-1997 Free Software Foundation, Inc.
;; Copyright (c) 1993, 1994 Sun Microsystems, Inc.
;; Copyright (C) 1995 Board of Trustees, University of Illinois
-;; Copyright (C) 2004 Steve Youngs
+;; Copyright (C) 2004 - 2015 Steve Youngs
;; Maintainer: SXEmacs Development Team
;; Keywords: internal, dumped
(defvar emacs-roots nil
"List of plausible roots of the SXEmacs hierarchy.")
-(defvar user-init-directory-base ".sxemacs"
- "Base of directory where user-installed init files may go.")
-
-(defvar user-init-directory
- (file-name-as-directory
- (paths-construct-path (list "~" user-init-directory-base)))
+(defun find-user-init-directory ()
+ "Find and set the user's init directory.
+
+If no init directory currently exists, this will return:
+\"$XDG_CONFIG_HOME/sxemacs\", which falls back to
+\"~/.config/sxemacs\" if $XDG_CONFIG_HOME is not set in the user's
+environment.
+
+If the legacy init directory, \"~/.sxemacs\" exists, return that.
+
+If both the legacy directory and the XDG-based directory exist, return
+the XDG-based directory unless $SXE_USE_LEGACY is set in the user's
+environment."
+ (let* ((legacy (getenv "SXE_USE_LEGACY"))
+ (xdg (getenv "XDG_CONFIG_HOME"))
+ (xdgdir (or (and xdg
+ (paths-construct-path
+ (list xdg "sxemacs")))
+ (paths-construct-path
+ (list (user-home-directory) ".config" "sxemacs"))))
+ (legacydir (paths-construct-path
+ (list (user-home-directory) ".sxemacs")))
+ (locations (list xdgdir legacydir))
+ (multi (count-if #'file-directory-p locations)))
+ (if legacy
+ (setq user-init-directory (file-name-as-directory legacydir))
+ (catch 'found
+ (dolist (dir locations)
+ (and (paths-file-readable-directory-p dir)
+ (throw 'found (setq user-init-directory
+ (file-name-as-directory dir)))))
+ (setq user-init-directory (file-name-as-directory xdgdir))))
+ ;; Warn if multiple init directories exist
+ (when (> multi 1)
+ (lwarn 'multi-initd nil
+ "Multiple init directories found:
+%S
+
+Currently using: %s
+
+See `display-warning-suppressed-classes' to suppress this warning"
+ locations user-init-directory))))
+
+(defvar user-init-directory ""
"Directory where user-installed init files may go.
-This defaults to \"~/.sxemacs\". Old XEmacs users can get up and
-running quickly by symlinking \"~/.sxemacs\" to their existing
-\"~/.xemacs\" directory.")
+See: `find-user-init-directory'.")
(defvar user-init-file-base-list '("init.elc" "init.el")
"List of allowed init files in the user's init directory.
(defvar site-start-file "site-start"
"File containing site-wide run-time initializations.
-This file is loaded at run-time before `~/.sxemacs/init.el'. It
+This file is loaded at run-time before `user-init-file'. 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 SXEmacs' dumped image. Thus, the run-time load order is:
1. file described in this variable, if non-nil;
- 2. `~/.sxemacs/init.el';
+ 2. `user-init-file';
3. `/path/to/sxemacs/lisp/default.el'.
Don't use the `site-start.el' file for things some users may not like.
(defvar command-switch-alist
'(("-help" . command-line-do-help)
- ("-version". command-line-do-version)
+ ("-h" . command-line-do-help)
+ ("-version" . command-line-do-version)
("-V" . command-line-do-version)
- ("-funcall". command-line-do-funcall)
+ ("-funcall" . command-line-do-funcall)
("-f" . command-line-do-funcall)
("-e" . command-line-do-funcall-1)
("-eval" . command-line-do-eval)
-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-pkgs-directory <directory> Use <directory> as the top of the local (early)
+ packages tree.
-user <user> Load user's init file instead of your own.
+ Probably not a wise thing to do.
-u <user> Same as -user.\n")
(let ((l command-switch-alist)
(insert (lambda (&rest x)
;; and keymaps.
))
+(defvar forced-user-init-directory nil
+ "Non-nil when `user-init-directory' is set on cmd line.
+
+Internal variable, DO NOT USE.")
+
(defun command-line-early (args)
;; This processes those switches which need to be processed before
;; starting up the window system.
(setq arg (pop args))
(cond
((or (string= arg "-q")
- (string= arg "-no-init-file"))
+ (string= arg "-no-init-file")
+ (string= arg "--no-init-file"))
(setq load-user-init-file-p nil))
- ((string= arg "-no-site-file")
+ ((or (string= arg "-no-site-file")
+ (string= arg "--no-site-file"))
(setq site-start-file nil))
((or (string= arg "-no-early-packages")
(string= arg "--no-early-packages"))
(setq inhibit-early-packages t))
- ((or (string= arg "-warn-early-package-shadows")
+ ((or (string= arg "-warn-early-package-shadows")
(string= arg "--warn-early-package-shadows"))
(setq warn-early-package-shadows t))
((or (string= arg "-vanilla")
(string= arg "--no-autoloads"))
(setq load-user-init-file-p nil
site-start-file nil))
- ((string= arg "-user-init-file")
+ ((or (string= arg "-user-init-file")
+ (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 "-user-init-directory")
+ (string= arg "--user-init-directory"))
+ (setq forced-user-init-directory t)
+ (setq user-init-directory (file-name-as-directory (pop args)))
+ (setq user-init-file (find-user-init-file user-init-directory))
+ (setq custom-file (make-custom-file-name user-init-file))
+ (startup-setup-paths emacs-roots
+ user-init-directory
+ inhibit-early-packages
+ debug-paths)
+ (unless inhibit-early-packages
+ (unless inhibit-autoloads
+ (packages-load-package-auto-autoloads
+ early-package-load-path)))
+ (setq lisp-initd-dir
+ (file-name-as-directory
+ (paths-construct-path (list user-init-directory
+ lisp-initd-basename)))))
((or (string= arg "-u")
- (string= arg "-user"))
+ (string= arg "-user")
+ (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))))
+ (home-user (concat "~" user))
+ (xdgdir (paths-construct-path
+ (list home-user ".config" "sxemacs")))
+ (xdgpdir (paths-construct-path
+ (list home-user ".local" "share" "sxemacs")))
+ (legacydir (paths-construct-path
+ (list home-user ".sxemacs")))
+ (dir-user (or (and (file-directory-p xdgdir)
+ (file-name-as-directory xdgdir))
+ (file-name-as-directory legacydir)))
+ (pdir-user (or (and (file-directory-p xdgpdir)
+ (file-name-as-directory xdgpdir))
+ (file-name-as-directory legacydir))))
+ (setq forced-user-init-directory t)
+ (setq user-init-directory dir-user)
+ (setq user-packages-topdir pdir-user)
(setq user-init-file
(find-user-init-file user-init-directory))
- (setq custom-file
- (make-custom-file-name user-init-file))))
- ((string= arg "-debug-init")
+ (setq custom-file (make-custom-file-name user-init-file))
+ (startup-setup-paths emacs-roots
+ user-init-directory
+ inhibit-early-packages
+ debug-paths)
+ (unless inhibit-early-packages
+ (unless inhibit-autoloads
+ (packages-load-package-auto-autoloads
+ early-package-load-path)))
+ (setq lisp-initd-dir
+ (file-name-as-directory
+ (paths-construct-path (list user-init-directory
+ lisp-initd-basename))))))
+ ((or (string= arg "-debug-init")
+ (string= arg "--debug-init"))
(setq init-file-debug t))
- ((string= arg "-unmapped")
+ ((or (string= arg "-unmapped")
+ (string= arg "--unmapped"))
(setq initial-frame-unmapped-p t))
((or (string= arg "-debug-paths")
(string= arg "--debug-paths"))
(with-obsolete-variable 'init-file-user
(setq init-file-user (and load-user-init-file-p "")))
+ (if (and debug-paths forced-user-init-directory)
+ (progn
+ (princ (format "user-init-directory:\n%S\n"
+ user-init-directory)
+ 'external-debugging-output)
+ (princ (format "lisp-initd-dir:\n\%S\n" lisp-initd-dir)
+ 'external-debugging-output)))
+
(nreverse new-args)))
(defconst initial-scratch-message
;;; Load user's init file and default ones.
(defun load-init-file ()
+
+ (require 'const-aliases)
+
(run-hooks 'before-init-hook)
;; Run the site-start library if it exists. The point of this file is
- And, above all, to have fun doing it.\n"
"\n--\n"
(face italic "
-Copyright (C) 2004 - 2009 Steve Youngs\n"))
+Copyright (C) 2004 - 2015 Steve Youngs\n"))
; Copyright (C) 1985-2001 Free Software Foundation, Inc.
; Copyright (C) 1990-1994 Lucid, Inc.
; Copyright (C) 1993-1997 Sun Microsystems, Inc. All Rights Reserved.
(defvar Info-directory-list)
-(defun startup-setup-paths (roots user-init-directory
+(defun startup-setup-paths (roots userdir
&optional
inhibit-early-packages debug-paths)
"Setup all the various paths.
ROOTS is a list of plausible roots of the SXEmacs directory hierarchy.
-If INHIBIT-PACKAGES is non-NIL, don't do packages.
-If DEBUG-PATHS is non-NIL, print paths as they are detected.
-It's idempotent, so call this as often as you like!"
-
+USERDIR is the user's init directory, possibly computed.
+If INHIBIT-EARLY-PACKAGES is non-NIL, don't do user packages.
+If DEBUG-PATHS is non-NIL, print paths as they are detected. It's
+idempotent, so call this as often as you like!"
+ ;; Maybe find a good candidate for user-init-directory, but only if
+ ;; SXEmacs was started without any command line arg that would set
+ ;; or change it.
+ (let ((allargs command-line-args)
+ (initdargs '("-u" "-user" "--user" "-user-init-directory"
+ "--user-init-directory")))
+ (unless
+ (or (member t (mapfam #'string= initdargs allargs :mode 'comb))
+ forced-user-init-directory)
+ (find-user-init-directory)
+ (setq userdir user-init-directory)
+ (setq lisp-initd-dir (file-name-as-directory
+ (paths-construct-path
+ (list userdir lisp-initd-basename))))
+ (if debug-paths
+ (progn
+ (princ (format "user-init-directory:\n%S\n"
+ user-init-directory)
+ 'external-debugging-output)
+ (princ (format "lisp-initd-dir:\n\%S\n" lisp-initd-dir)
+ 'external-debugging-output)))))
+ ;; Packages
+ (setq user-packages-topdir (packages-find-user-topdir))
+ (when debug-paths
+ (princ (format "user-packages-topdir: \n%S\n"
+ user-packages-topdir)
+ 'external-debugging-output))
(apply #'(lambda (early late last)
(setq early-packages (and (not inhibit-early-packages)
early))
(setq last-packages last))
(packages-find-packages
roots
- (packages-compute-package-locations user-init-directory)))
+ (packages-compute-package-locations user-packages-topdir)))
(setq early-package-load-path
(packages-find-package-load-path early-packages)
(princ (format "last-packages and last-package-load-path:\n%S\n%S\n"
last-packages last-package-load-path)
'external-debugging-output)))
-
+ ;; Core lisp
(setq lisp-directory (paths-find-lisp-directory roots))
(if debug-paths
(princ (format "lisp-directory:\n%S\n" lisp-directory)
'external-debugging-output))
-
+ ;; mule (core)
(if (featurep 'mule)
(progn
(setq mule-lisp-directory
mule-lisp-directory)
'external-debugging-output)))
(setq mule-lisp-directory '()))
-
+ ;; FFI
(setq ffi-lisp-directory
(when (fboundp #'ffi-defun)
(paths-find-ffi-lisp-directory roots
nil
mule-lisp-directory
ffi-lisp-directory))
-
+ ;; Info
(setq Info-directory-list
(paths-construct-info-path roots
early-packages late-packages last-packages))
(if debug-paths
(princ (format "exec-directory:\n%s\n" exec-directory)
'external-debugging-output))
-
+ ;; Exec
(setq exec-path
(paths-construct-exec-path roots exec-directory
early-packages late-packages last-packages))
(if debug-paths
(princ (format "exec-path:\n%S\n" exec-path)
'external-debugging-output))
-
+ ;; Doc
(setq doc-directory (paths-find-doc-directory roots))
(if debug-paths
(princ (format "doc-directory:\n%S\n" doc-directory)
'external-debugging-output))
-
+ ;; Data
(setq data-directory (paths-find-data-directory roots))
(if debug-paths
projects / sxemacs / blobdiff