XDG init -- Git rid of hack in site-start.el

It was wrong to use site-start.el to cope with a dynamic user init
directory.  This changeset puts it all into startup.el and removes the
site-start.el file.  Admins can breath a sigh of relief. :)

user-init-directory and lisp-initd-dir will now also be included in the
debugging output when using -debug-paths.

	* lisp/Makefile.am (corelispels): Remove site-start.el

	* lisp/site-start.el: Removed.

	* lisp/startup.el (find-user-init-directory): Actually set
	user-init-directory.
	Warn if multiple init directories were found.
	(forced-user-init-directory): New, non-nil when the
	user-init-directory has been set explicitly via the command
	line. NOT a user variable, keep ya grubby paws offit.
	(command-line-early): Ensure that all paths are correct when using
	"-u", "-user", "-user-init-directory", and inlude
	user-init-directory and lisp-initd-dir with -debug-paths.
	(startup-setup-paths): Use #'find-user-init-directory to maybe
	find the user's init directory.  Include user-init-directory, and
	lisp-initd-dir in debug output when -debug-paths.

Signed-off-by: Steve Youngs <steve@sxemacs.org>

diff --git a/lisp/Makefile.am b/lisp/Makefile.am
index 3276074..faa1730 100644 (file)
--- a/lisp/Makefile.am
+++ b/lisp/Makefile.am
@@ -96,14 +96,13 @@ corelispels =                                                               \
        page.el paragraphs.el paths.el picture.el printer.el            \
        process.el rect.el regexp-opt.el register.el replace.el         \
        resize-minibuffer.el scrollbar.el select.el shadow.el simple.el \
        page.el paragraphs.el paths.el picture.el printer.el            \
        process.el rect.el regexp-opt.el register.el replace.el         \
        resize-minibuffer.el scrollbar.el select.el shadow.el simple.el \

-       site-start.el sound.el specifier.el subr.el symbol-syntax.el    \
-        symbols.el syntax.el text-mode.el text-props.el                 \
-       toolbar-items.el toolbar.el tty-init.el undo-stack.el           \
-       userlock.el version.el view-less.el wid-browse.el wid-edit.el   \
-       widget.el window-xemacs.el window.el x-color.el x-compose.el    \
-       x-faces.el x-font-menu.el x-init.el x-iso8859-1.el x-misc.el    \
-       x-mouse.el x-scrollbar.el x-select.el x-win-sun.el              \
-       x-win-xfree86.el
+       sound.el specifier.el subr.el symbol-syntax.el symbols.el       \
+        syntax.el text-mode.el text-props.el toolbar-items.el           \
+        toolbar.el tty-init.el undo-stack.el userlock.el version.el     \
+        view-less.el wid-browse.el wid-edit.el widget.el                \
+        window-xemacs.el window.el x-color.el x-compose.el x-faces.el   \
+        x-font-menu.el x-init.el x-iso8859-1.el x-misc.el x-mouse.el    \
+        x-scrollbar.el x-select.el x-win-sun.el x-win-xfree86.el

 
 ffilispels =                                                           \
        ffi/ffi-curl.el ffi/ffi-gcrypt.el ffi/ffi-libc.el               \
 
 ffilispels =                                                           \
        ffi/ffi-curl.el ffi/ffi-gcrypt.el ffi/ffi-libc.el               \

diff --git a/lisp/site-start.el b/lisp/site-start.el
deleted file mode 100644 (file)
index c8955a6..0000000
--- a/lisp/site-start.el
+++ /dev/null
@@ -1,58 +0,0 @@
-;;; site-start.el --- Site-wide customisations
-;;                    that must be loaded before the user's init files
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Up until now (May, 2015), user-init-directory had always been
-;; hard-coded to ~/.sxemacs.  Today we take a more "dynamic"
-;; approach and support $XDG_CONFIG_HOME as well.  Unfortunately,
-;; that flexibility has consequences.  This snippet deals with
-;; those consequences. --SY
-(when (zerop (length user-init-directory))
-
-  ;; Compute the init directory location
-  (setq user-init-directory (find-user-init-directory))
-
-  ;; Make sure the load-path includes any packages the user may have
-  ;; in their local setup.
-  (unless inhibit-early-packages
-    (startup-setup-paths emacs-roots user-init-directory))
-
-  ;; There could possibly now be some more auto-autoloads to load from
-  ;; the user's local packages.
-  (unless inhibit-autoloads
-    (unless inhibit-early-packages
-      (packages-load-package-auto-autoloads early-package-load-path)))
-
-  ;; emodules ?
-
-  ;; Reset the lisp init.d directory
-  (setq lisp-initd-dir
-       (file-name-as-directory
-        (paths-construct-path (list user-init-directory
-                                    lisp-initd-basename))))
-
-  ;; Lastly, warn the user if multiple candidates for user-init-directory
-  ;; were found.
-  (let* ((legacy (expand-file-name "~/.sxemacs"))
-        (xdg (expand-file-name "sxemacs"
-                               (getenv "XDG_CONFIG_HOME")))
-        (fback (paths-construct-path
-                (list (user-home-directory) ".config" "sxemacs")))
-        (dirs (remove-duplicates
-               (list legacy xdg fback) :test #'string=))
-        (ndirs (count-if #'file-directory-p dirs)))
-    (when (> ndirs 1)
-      (lwarn 'multi-initd nil
-       "Multiple init directories found:
-%S
-
-Currently using: %s
-
-See `display-warning-suppressed-classes' to suppress this warning"
-       dirs user-init-directory))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Site-specific additions go here.
-
-
-;;; End site-start.el

diff --git a/lisp/startup.el b/lisp/startup.el
index 81e668d..ce95a33 100644 (file)
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -93,7 +93,7 @@ the user's init file.")
   "List of plausible roots of the SXEmacs hierarchy.")
 
 (defun find-user-init-directory ()
   "List of plausible roots of the SXEmacs hierarchy.")
 
 (defun find-user-init-directory ()

-  "Find the user's 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
 
 If no init directory currently exists, this will return:
 \"$XDG_CONFIG_HOME/sxemacs\", which falls back to


@@ -114,14 +114,26 @@ environment."
                      (list (user-home-directory) ".config" "sxemacs"))))
         (legacydir (paths-construct-path
                     (list (user-home-directory) ".sxemacs")))
                      (list (user-home-directory) ".config" "sxemacs"))))
         (legacydir (paths-construct-path
                     (list (user-home-directory) ".sxemacs")))

-        (locations (list xdgdir legacydir)))
+        (locations (list xdgdir legacydir))
+        (multi (count-if #'file-directory-p locations)))

     (if legacy
     (if legacy

-       (file-name-as-directory legacydir)
+       (setq user-init-directory (file-name-as-directory legacydir))

       (catch 'found
        (dolist (dir locations)
          (and (paths-file-readable-directory-p dir)
       (catch 'found
        (dolist (dir locations)
          (and (paths-file-readable-directory-p dir)

-              (throw 'found (file-name-as-directory dir))))
-       (file-name-as-directory xdgdir)))))
+              (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.
 
 (defvar user-init-directory ""
   "Directory where user-installed init files may go.


@@ -471,6 +483,11 @@ Type ^H^H^H (Control-h Control-h Control-h) to get more help options.\n")
     ;; and keymaps.
     ))
 
     ;; 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.
 (defun command-line-early (args)
   ;; This processes those switches which need to be processed before
   ;; starting up the window system.


@@ -506,7 +523,7 @@ Type ^H^H^H (Control-h Control-h Control-h) to get more help options.\n")
        ((or (string= arg "-no-early-packages")
            (string= arg "--no-early-packages"))
        (setq inhibit-early-packages t))
        ((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 "--warn-early-package-shadows"))
        (setq warn-early-package-shadows t))
        ((or (string= arg "-vanilla")


@@ -519,22 +536,50 @@ Type ^H^H^H (Control-h Control-h Control-h) to get more help options.\n")
        ((string= arg "-user-init-file")
        (setq user-init-file (pop args)))
        ((string= arg "-user-init-directory")
        ((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))))
+       (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"))
        (let* ((user (pop args))
               (home-user (concat "~" user))
               (xdgdir (paths-construct-path
                        (list home-user ".config" "sxemacs")))
        ((or (string= arg "-u")
            (string= arg "-user"))
        (let* ((user (pop args))
               (home-user (concat "~" user))
               (xdgdir (paths-construct-path
                        (list home-user ".config" "sxemacs")))

-              (legacydir (paths-construct-path (list home-user ".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))))
               (dir-user (or (and (file-directory-p xdgdir)
                                  (file-name-as-directory xdgdir))
                             (file-name-as-directory legacydir))))

+         (setq forced-user-init-directory t)

          (setq user-init-directory dir-user)
          (setq user-init-file
                (find-user-init-file user-init-directory))
          (setq user-init-directory dir-user)
          (setq user-init-file
                (find-user-init-file user-init-directory))

-         (setq custom-file
-               (make-custom-file-name user-init-file))))
+         (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))))))

        ((string= arg "-debug-init")
        (setq init-file-debug t))
        ((string= arg "-unmapped")
        ((string= arg "-debug-init")
        (setq init-file-debug t))
        ((string= arg "-unmapped")


@@ -551,6 +596,14 @@ Type ^H^H^H (Control-h Control-h Control-h) to get more help options.\n")
     (with-obsolete-variable 'init-file-user
       (setq init-file-user (and load-user-init-file-p "")))
 
     (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
     (nreverse new-args)))
 
 (defconst initial-scratch-message


@@ -979,7 +1032,7 @@ a new format, when variables have changed, etc."
   - And, above all, to have fun doing it.\n"
      "\n--\n"
      (face italic "
   - And, above all, to have fun doing it.\n"
      "\n--\n"
      (face italic "

-Copyright (C) 2004 - 2012 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.
 ; Copyright (C) 1985-2001 Free Software Foundation, Inc.
 ; Copyright (C) 1990-1994 Lucid, Inc.
 ; Copyright (C) 1993-1997 Sun Microsystems, Inc. All Rights Reserved.


@@ -1089,15 +1142,36 @@ Copyright (C) 2004 - 2012 Steve Youngs\n"))
 
 (defvar Info-directory-list)
 
 
 (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.
                                  &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-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

   (apply #'(lambda (early late last)
             (setq early-packages (and (not inhibit-early-packages)
                                       early))
   (apply #'(lambda (early late last)
             (setq early-packages (and (not inhibit-early-packages)
                                       early))


@@ -1105,7 +1179,7 @@ It's idempotent, so call this as often as you like!"
             (setq last-packages last))
         (packages-find-packages
          roots
             (setq last-packages last))
         (packages-find-packages
          roots

-         (packages-compute-package-locations user-init-directory)))
+         (packages-compute-package-locations userdir)))

 
   (setq early-package-load-path
        (packages-find-package-load-path early-packages)
 
   (setq early-package-load-path
        (packages-find-package-load-path early-packages)


@@ -1127,13 +1201,13 @@ It's idempotent, so call this as often as you like!"
        (princ (format "last-packages and last-package-load-path:\n%S\n%S\n"
                       last-packages last-package-load-path)
               'external-debugging-output)))
        (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))
   (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
   (if (featurep 'mule)
       (progn
        (setq mule-lisp-directory


@@ -1144,7 +1218,7 @@ It's idempotent, so call this as often as you like!"
                           mule-lisp-directory)
                   'external-debugging-output)))
     (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
   (setq ffi-lisp-directory
        (when (fboundp #'ffi-defun)
          (paths-find-ffi-lisp-directory roots


@@ -1169,7 +1243,7 @@ It's idempotent, so call this as often as you like!"
                                             nil
                                             mule-lisp-directory
                                             ffi-lisp-directory))
                                             nil
                                             mule-lisp-directory
                                             ffi-lisp-directory))

-
+  ;; Info

   (setq Info-directory-list
        (paths-construct-info-path roots
                                   early-packages late-packages last-packages))
   (setq Info-directory-list
        (paths-construct-info-path roots
                                   early-packages late-packages last-packages))


@@ -1184,7 +1258,7 @@ It's idempotent, so call this as often as you like!"
   (if debug-paths
       (princ (format "exec-directory:\n%s\n" exec-directory)
             'external-debugging-output))
   (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))
   (setq exec-path
        (paths-construct-exec-path roots exec-directory
                                   early-packages late-packages last-packages))


@@ -1192,13 +1266,13 @@ It's idempotent, so call this as often as you like!"
   (if debug-paths
       (princ (format "exec-path:\n%S\n" exec-path)
             'external-debugging-output))
   (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))
   (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
   (setq data-directory (paths-find-data-directory roots))
 
   (if debug-paths