;; 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 load-user-init-file-p t
"Non-nil if SXEmacs should load the user's init file.")
-(defvar lisp-initd-dir
- (file-name-as-directory
- (paths-construct-path (list user-init-directory "init.d")))
- "The default directory for the init files.")
-
;; #### called `site-run-file' in FSFmacs
(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)
(princ " following options are accepted:
-sd Show dump ID. Ignored when configured without --pdump.
-nd Don't load the dump file. Roughly like old temacs.
- Ignored when configured without --pdump.
+ Ignored when configured without --pdump.
-t <device> Use TTY <device> instead of the terminal for input
- and output. This implies the -nw option.
+ and output. This implies the -nw option.
-nw Inhibit the use of any window-system-specific
- display code: use the current tty.
+ display code: use the current tty.
-batch Execute noninteractively (messages go to stderr).
-debug-init Enter the debugger if an error in the init file occurs.
-unmapped Do not map the initial frame.
-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)
(princ " ")
(incf len))))))
(while l
- (let ((name (car (car l)))
- (fn (cdr (car l)))
+ (let ((name (car (car l)))
+ (fn (cdr (car l)))
doc arg cons)
(cond
((and (symbolp fn) (get fn 'undocumented)) nil)
(funcall insert name))
(princ doc)
(terpri))))
- (setq l (cdr l))))
+ (setq l (cdr l))))
(princ (concat "+N <file> Start displaying <file> at line N.
Anything else is considered a file name, and is placed into a buffer for
invocation-name))
(when debug-paths
- (princ (format "invocation: p:%S n:%S\n"
- invocation-directory invocation-name)
- 'external-debugging-output)
- (princ (format "emacs-roots:\n%S\n" emacs-roots)
- 'external-debugging-output))
+ (princ (format "invocation: p:%S n:%S\n"
+ invocation-directory invocation-name)
+ 'external-debugging-output)
+ (princ (format "emacs-roots:\n%S\n" emacs-roots)
+ 'external-debugging-output))
(if (null emacs-roots)
(startup-find-roots-warning))
(setq window-setup-hook nil)
(if error-data
;; re-signal, and don't allow continuation as that will probably
- ;; wipe out the user's .emacs if she hasn't migrated yet!
+ ;; wipe out the user's .emacs if she hasn't migrated yet!
;; Not applicable to SXEmacs --SY.
(signal-error (car error-data) (cdr error-data))))
;; 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
+(defconst initial-scratch-message
";; This buffer is for notes you don't want to save, and for Lisp evaluation.
;; If you want to create a file, first visit that file with C-x C-f,
;; then enter the text in that file's own buffer.
;;
-;; In \"SXEmacs-speak\", `C-char' and `M-char' are abbreviations that mean
-;; `Control+char' and `Meta+char' (hold down the Control or Meta key while
+;; In \"SXEmacs-speak\", `C-char' and `M-char' are abbreviations that mean
+;; `Control+char' and `Meta+char' (hold down the Control or Meta key while
;; pressing `char').
;;
;; For Lisp evaluation, type an expression, move to the end and hit C-j.
;;; 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
(if load-user-init-file-p
(load-user-init-file))
(setq init-file-had-error nil))
- (error
+ (error
(message "Error in init file: %s" (error-message-string error))
(display-warning 'initialization
(format "An error has occurred while loading %s:
(interactive)
(let ((e last-command-event))
(and (button-press-event-p e)
- (setq e (extent-at (event-point e)
- (event-buffer e)
- 'startup-presentation-hack))
- (setq e (extent-property e 'startup-presentation-hack))
- (if (consp e)
- (apply (car e) (cdr e))
+ (setq e (extent-at (event-point e)
+ (event-buffer e)
+ 'startup-presentation-hack))
+ (setq e (extent-property e 'startup-presentation-hack))
+ (if (consp e)
+ (apply (car e) (cdr e))
(while (keymapp (indirect-function e))
(let ((map e)
(overriding-local-map (indirect-function e)))
(defun splash-frame-present-hack (e v)
;; (set-extent-property e 'mouse-face 'highlight)
;; (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 'help-echo
- ;; 'startup-presentation-hack-help)
+ ;; 'startup-presentation-hack-help)
)
(defun splash-frame-present (l)
(cond ((stringp l)
- (insert l))
- ((eq (car-safe l) 'face)
- ;; (face name string)
- (let ((p (point)))
- (splash-frame-present (elt l 2))
- (if (fboundp 'set-extent-face)
- (set-extent-face (make-extent p (point))
- (elt l 1)))))
- ((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)
+ (insert l))
+ ((eq (car-safe l) 'face)
+ ;; (face name string)
+ (let ((p (point)))
+ (splash-frame-present (elt l 2))
+ (if (fboundp 'set-extent-face)
+ (set-extent-face (make-extent p (point))
+ (elt l 1)))))
+ ((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)))
- (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))
+ (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)))))
((consp l)
(mapcar 'splash-frame-present l))
- (t
- (backtrace 'external-debugging-output)
- (error "WTF!?"))))
+ (t
+ (backtrace 'external-debugging-output)
+ (error "WTF!?"))))
(defun startup-center-spaces (glyph)
;; Return the number of spaces to insert in order to center
(defun splash-frame-body ()
`[((face (blue bold underline)
"\nDistribution, copying license, warranty:\n\n")
- "Please visit the SXEmacs website at http://www.sxemacs.org !\n\n"
+ "Please visit the SXEmacs website at https://www.sxemacs.org !\n\n"
((key describe-no-warranty)
": "(face (red bold) "SXEmacs comes with ABSOLUTELY NO WARRANTY\n"))
((key describe-copying)
- 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.
(defun display-splash-frame ()
(let ((logo sxemacs-logo)
(buffer-read-only nil)
- (cramped-p (eq 'tty (console-type))))
+ (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)
(client-data `[ 1 ,(point) ,(current-buffer) ,elements ])
tmout)
(if (listp elements) ;; A single element to display
- (splash-frame-present (splash-frame-body))
+ (splash-frame-present (splash-frame-body))
;; several elements to rotate
- (splash-frame-present (aref elements 0))
+ (splash-frame-present (aref elements 0))
(setq tmout (add-timeout splash-frame-timeout
'circulate-splash-frame-elements
client-data splash-frame-timeout)))
(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)
- late-package-load-path
- (packages-find-package-load-path late-packages)
- last-package-load-path
- (packages-find-package-load-path last-packages))
+ (packages-find-package-load-path early-packages)
+ late-package-load-path
+ (packages-find-package-load-path late-packages)
+ last-package-load-path
+ (packages-find-package-load-path last-packages))
(if debug-paths
(progn
(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
- lisp-directory)))
+ (when (fboundp #'ffi-defun)
+ (paths-find-ffi-lisp-directory roots
+ lisp-directory)))
;; Modules
(setq module-directory (paths-find-module-directory roots))
(if debug-paths
(princ (format "module-directory:\n%S\n" module-directory)
- 'external-debugging-output))
+ 'external-debugging-output))
(setq site-module-directory (and (null inhibit-site-modules)
(paths-find-site-module-directory roots)))
(if (and debug-paths (null inhibit-site-modules))
(princ (format "site-module-directory:\n%S\n" site-module-directory)
- 'external-debugging-output))
+ 'external-debugging-output))
(setq load-path (paths-construct-load-path roots
early-package-load-path
lisp-directory
nil
mule-lisp-directory
- ffi-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
'external-debugging-output))
(setq data-directory-list
- (paths-construct-data-directory-list data-directory
- early-packages
- late-packages
- last-packages))
+ (paths-construct-data-directory-list data-directory
+ early-packages
+ late-packages
+ last-packages))
(if debug-paths
(princ (format "data-directory-list:\n%S\n" data-directory-list)
'external-debugging-output)))
(setq warnings (cdr warnings)))
(insert "Perhaps some directories don't exist, "
"or the SXEmacs executable,\n"
- (concat invocation-directory invocation-name)
+ (concat invocation-directory invocation-name)
"\nis in a strange place?")
(princ "\nWARNING:\n" 'external-debugging-output)
"Load autoloads from known locations."
(when (and (not inhibit-autoloads)
- (or lisp-directory module-directory))
+ (or lisp-directory module-directory))
;; ordinary auto-autoloads in lisp/
(let ((aalfile (file-name-sans-extension autoload-file-name)))
(condition-case nil
- (load (expand-file-name aalfile lisp-directory) nil t)
- (error . nil))
+ (load (expand-file-name aalfile lisp-directory) nil t)
+ (error . nil))
;; just load them all
(mapc-internal
#'(lambda (root)
- (condition-case nil
- (load (expand-file-name (concat "lisp/" aalfile) root) nil t)
- (error . nil)))
+ (condition-case nil
+ (load (expand-file-name (concat "lisp/" aalfile) root) nil t)
+ (error . nil)))
emacs-roots)
(when (featurep 'mule)
- (load (expand-file-name aalfile
- (expand-file-name "mule" lisp-directory))
- t t))
+ (load (expand-file-name aalfile
+ (expand-file-name "mule" lisp-directory))
+ t t))
(when (featurep 'modules)
- (load (expand-file-name aalfile module-directory) t t))
+ (load (expand-file-name aalfile module-directory) t t))
(when (fboundp #'ffi-defun)
- (load (expand-file-name aalfile
- (expand-file-name "ffi" lisp-directory))
- t t))))
+ (load (expand-file-name aalfile
+ (expand-file-name "ffi" lisp-directory))
+ t t))))
(unless inhibit-autoloads
(unless inhibit-early-packages
(if (and (not inhibit-early-packages) (not warn-early-package-shadows))
(let ((early-path (mapcar 'file-basename early-package-load-path))
late-load-path)
- (mapc (lambda (path)
+ (mapc (lambda (path)
(unless (member (file-basename path) early-path)
(setq late-load-path (append late-load-path (list path)))))
late-package-load-path)
projects / sxemacs / blobdiff