XDG Compliant user (early) packages tree.
authorSteve Youngs <steve@sxemacs.org>
Thu, 4 Jun 2015 13:36:25 +0000 (23:36 +1000)
committerSteve Youngs <steve@sxemacs.org>
Thu, 4 Jun 2015 13:36:25 +0000 (23:36 +1000)
With this changeset, the location for a user's local packages, the ones
that make up `early-packages', is now under ${XDG_DATA_HOME}/sxemacs.
That is normally ~/.local/share/sxemacs, which is the directory used when
the XDG environment variable isn't set.

If the user has forced use of the old legacy ~/.sxemacs for their init
directory, then that is where the early-packages will be instead of the
XDG location.  A warning is displayed if package subdirectories are
detected in any 2 or more of ~/.sxemacs, ${XDG_CONFIG_HOME}/sxemacs, and
${XDG_DATA_HOME}/sxemacs (symlinked directories are ignored).

There is also a new command line switch, `-user-pkgs-directory' to set the
early-packages directory to any location.

* lisp/package-admin.el (package-admin-find-top-directory): Use
`user-packages-topdir' instead of `user-init-directory'.
(package-admin-get-install-dir): Ditto.

* lisp/package-get.el (package-get-package-index-file-location):
Default location is now in `user-packages-topdir' instead of
`user-init-directory'.
(package-get-install-to-user-directory): Renamed from
`package-get-install-to-user-init-directory'.  The latter is
defvaralias'd back.
(package-get-maybe-save-index): Use `user-packages-topdir' instead
of `user-init-directory'.

* lisp/packages.el (packages-find-user-topdir): New.  Returns
`user-packages-topdir'.
(packages-compute-package-locations): Rename the arg to
`user-packages-topdir', and update the doc string.

* lisp/startup.el (command-line-do-help): Add `-user-pkgs-directory'.
(command-line-early): For `-user' set an XDG compliant directory
for `user-packages-topdir' if possible, fall back to the legacy
.sxemacs otherwise.
(startup-setup-paths): Use #'packages-find-user-topdir to set
`user-packages-topdir'.

* src/emacs.c (vars_of_emacs): New var, `Vuser_packages_topdir'.
(main_1): Handle new command line arg, `-user-pkgs-directory'. Set
`Vuser_packages_topdir'.

Signed-off-by: Steve Youngs <steve@sxemacs.org>
lisp/package-admin.el
lisp/package-get.el
lisp/packages.el
lisp/startup.el
src/emacs.c

index 09aeee7..8b8112f 100644 (file)
@@ -1,7 +1,7 @@
 ;;; package-admin.el --- Installation and Maintenance of SXEmacs packages
 
 ;; Copyright (C) 1997 by Free Software Foundation, Inc.
 ;;; package-admin.el --- Installation and Maintenance of SXEmacs packages
 
 ;; Copyright (C) 1997 by Free Software Foundation, Inc.
-;; Copyright (C) 2003, 2004 Steve Youngs.
+;; Copyright (C) 2003 - 2015 Steve Youngs.
 
 ;; Author: SL Baur <steve@xemacs.org>
 ;; Keywords: internal
 
 ;; Author: SL Baur <steve@xemacs.org>
 ;; Keywords: internal
@@ -130,7 +130,7 @@ to BUFFER."
   (require 'packages)
   (autoload 'package-get-info "package-get")
   (autoload 'paths-decode-directory-path "find-paths")
   (require 'packages)
   (autoload 'package-get-info "package-get")
   (autoload 'paths-decode-directory-path "find-paths")
-  (defvar package-get-install-to-user-init-directory))
+  (defvar package-get-install-to-user-directory))
 
 (defun package-admin-find-top-directory (type &optional user-dir)
   "Return the top level directory for a package.
 
 (defun package-admin-find-top-directory (type &optional user-dir)
   "Return the top level directory for a package.
@@ -139,7 +139,7 @@ Argument TYPE is a symbol that determines the type of package we're
 trying to find a directory for.
 
 Optional Argument USER-DIR if non-nil use directories off
 trying to find a directory for.
 
 Optional Argument USER-DIR if non-nil use directories off
-`user-init-directory'.  This overrides everything except
+`user-packages-topdir'.  This overrides everything except
 \"EMACSPACKAGEPATH\".
 
 This function honours the environment variable \"EMACSPACKAGEPATH\"
 \"EMACSPACKAGEPATH\".
 
 This function honours the environment variable \"EMACSPACKAGEPATH\"
@@ -189,27 +189,32 @@ Possible values for TYPE are:
                              "mule-packages")
                       (setq top-dir (car path-list)))
                   (setq path-list (cdr path-list)))))))
                              "mule-packages")
                       (setq top-dir (car path-list)))
                   (setq path-list (cdr path-list)))))))
-    ;; Wasn't in the environment, try `user-init-directory' if
+    ;; Wasn't in the environment, try `user-packages-topdir' if
     ;; USER-DIR is non-nil.
     (if (and user-dir
             (not top-dir))
        (cond ((eq type 'site)
               (setq top-dir (file-name-as-directory
     ;; USER-DIR is non-nil.
     (if (and user-dir
             (not top-dir))
        (cond ((eq type 'site)
               (setq top-dir (file-name-as-directory
-                             (expand-file-name "site-packages" user-init-directory))))
+                             (expand-file-name "site-packages"
+                                               user-packages-topdir))))
              ((eq type 'sxemacs)
               (setq top-dir (file-name-as-directory
              ((eq type 'sxemacs)
               (setq top-dir (file-name-as-directory
-                             (expand-file-name "sxemacs-packages" user-init-directory))))
+                             (expand-file-name "sxemacs-packages"
+                                               user-packages-topdir))))
              ((eq type 'std)
               (setq top-dir (file-name-as-directory
              ((eq type 'std)
               (setq top-dir (file-name-as-directory
-                             (expand-file-name "xemacs-packages" user-init-directory))))
+                             (expand-file-name "xemacs-packages"
+                                               user-packages-topdir))))
              ((eq type 'mule)
               (setq top-dir (file-name-as-directory
              ((eq type 'mule)
               (setq top-dir (file-name-as-directory
-                             (expand-file-name "mule-packages" user-init-directory))))))
+                             (expand-file-name "mule-packages"
+                                               user-packages-topdir))))))
     ;; Finally check the normal places
     (if (not top-dir)
        (let ((path-list (nth 1 (packages-find-packages
                                 emacs-roots
     ;; Finally check the normal places
     (if (not top-dir)
        (let ((path-list (nth 1 (packages-find-packages
                                 emacs-roots
-                                (packages-compute-package-locations user-init-directory)))))
+                                (packages-compute-package-locations
+                                 user-packages-topdir)))))
          (cond ((eq type 'site)
                 (while path-list
                   (if (equal (file-name-nondirectory
          (cond ((eq type 'site)
                 (while path-list
                   (if (equal (file-name-nondirectory
@@ -250,17 +255,17 @@ installation.
 
 If PKG-DIR is non-nil and writable, return that.  Otherwise check to
 see if the PACKAGE is already installed and return that location, if
 
 If PKG-DIR is non-nil and writable, return that.  Otherwise check to
 see if the PACKAGE is already installed and return that location, if
-it is writable.  Finally, fall back to the `user-init-directory' if
+it is writable.  Finally, fall back to the `user-packages-topdir' if
 all else fails.  As a side effect of installing packages under
 all else fails.  As a side effect of installing packages under
-`user-init-directory' these packages become part of `early-packages'."
+`user-packages-topdir' these packages become part of `early-packages'."
   ;; If pkg-dir specified, return that if writable.
   (if (and pkg-dir
           (file-writable-p (directory-file-name pkg-dir)))
       pkg-dir
     ;; If the user want her packages in her $HOME, do so.  Currently,
   ;; If pkg-dir specified, return that if writable.
   (if (and pkg-dir
           (file-writable-p (directory-file-name pkg-dir)))
       pkg-dir
     ;; If the user want her packages in her $HOME, do so.  Currently,
-    ;; that means in `user-init-directory'.
+    ;; that means in `user-packages-topdir'.
     (let ((type (package-get-info package 'category)))
     (let ((type (package-get-info package 'category)))
-      (if package-get-install-to-user-init-directory
+      (if package-get-install-to-user-directory
          (progn
            (cond ((equal type "site")
                   (setq pkg-dir (package-admin-find-top-directory 'site 'user-dir)))
          (progn
            (cond ((equal type "site")
                   (setq pkg-dir (package-admin-find-top-directory 'site 'user-dir)))
@@ -308,9 +313,9 @@ all else fails.  As a side effect of installing packages under
                pkg-dir
              ;; Oh no!  Either we still haven't found a suitable
              ;; directory, or we can't write to the one we did find.
                pkg-dir
              ;; Oh no!  Either we still haven't found a suitable
              ;; directory, or we can't write to the one we did find.
-             ;; Drop back to the `user-init-directory'.
+             ;; Drop back to the `user-packages-topdir'.
              (if (y-or-n-p (format "Directory isn't writable, use %s instead? "
              (if (y-or-n-p (format "Directory isn't writable, use %s instead? "
-                                   user-init-directory))
+                                   user-packages-topdir))
                  (progn
                    (cond ((equal type "site")
                           (setq pkg-dir (package-admin-find-top-directory 'site 'user-dir)))
                  (progn
                    (cond ((equal type "site")
                           (setq pkg-dir (package-admin-find-top-directory 'site 'user-dir)))
@@ -323,10 +328,10 @@ all else fails.  As a side effect of installing packages under
                          (t
                           (error 'invalid-operation
                                  "Invalid package type")))
                          (t
                           (error 'invalid-operation
                                  "Invalid package type")))
-                   ;; Turn on `package-get-install-to-user-init-directory'
+                   ;; Turn on `package-get-install-to-user-directory'
                    ;; so we don't get asked for each package we try to
                    ;; install in this session.
                    ;; so we don't get asked for each package we try to
                    ;; install in this session.
-                   (setq package-get-install-to-user-init-directory t)
+                   (setq package-get-install-to-user-directory t)
                    pkg-dir)
                ;; If we get to here SXEmacs can't make up its mind and
                ;; neither can the user, nothing left to do except barf. :-(
                    pkg-dir)
                ;; If we get to here SXEmacs can't make up its mind and
                ;; neither can the user, nothing left to do except barf. :-(
index f858729..426f826 100644 (file)
@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 1998 by Pete Ware
 ;; Copyright (C) 2002 Ben Wing.
 
 ;; Copyright (C) 1998 by Pete Ware
 ;; Copyright (C) 2002 Ben Wing.
-;; Copyright (C) 2003 - 2012 Steve Youngs
+;; Copyright (C) 2003 - 2015 Steve Youngs
 
 ;; Author: Pete Ware <ware@cis.ohio-state.edu>
 ;; Heavy-Modifications: Greg Klanderman <greg@alphatech.com>
 
 ;; Author: Pete Ware <ware@cis.ohio-state.edu>
 ;; Heavy-Modifications: Greg Klanderman <greg@alphatech.com>
@@ -169,17 +169,20 @@ one version of a package available.")
 
 ;;;###autoload
 (defcustom package-get-package-index-file-location
 
 ;;;###autoload
 (defcustom package-get-package-index-file-location
-  (car (split-path (or (getenv "EMACSPACKAGEPATH") user-init-directory)))
+  (car (split-path (or (getenv "EMACSPACKAGEPATH") user-packages-topdir)))
   "*The directory where the package-index file can be found."
   :type 'directory
   :group 'package-get)
 
 ;;;###autoload
   "*The directory where the package-index file can be found."
   :type 'directory
   :group 'package-get)
 
 ;;;###autoload
-(defcustom package-get-install-to-user-init-directory nil
-  "*If non-nil install packages under `user-init-directory'."
+(defcustom package-get-install-to-user-directory nil
+  "*If non-nil install packages under `user-packages-topdir'."
   :type 'boolean
   :group 'package-get)
 
   :type 'boolean
   :group 'package-get)
 
+(defvaralias 'package-get-install-to-user-init-directory
+  'package-get-install-to-user-directory)
+
 (define-widget 'host-name 'string
   "A Host name."
   :tag "Host")
 (define-widget 'host-name 'string
   "A Host name."
   :tag "Host")
@@ -491,7 +494,7 @@ if different."
                            (md5 (current-buffer)))))
        (when (not (file-writable-p location))
          (if (y-or-n-p (format "Sorry, %s is read-only, can I use %s? "
                            (md5 (current-buffer)))))
        (when (not (file-writable-p location))
          (if (y-or-n-p (format "Sorry, %s is read-only, can I use %s? "
-                               location user-init-directory))
+                               location user-packages-topdir))
              (setq location (expand-file-name
                              package-get-base-filename
                              package-get-package-index-file-location))
              (setq location (expand-file-name
                              package-get-base-filename
                              package-get-package-index-file-location))
index e401b03..881ad12 100644 (file)
@@ -2,9 +2,10 @@
 
 ;; Copyright (C) 1997 Free Software Foundation, Inc.
 ;; Copyright (C) 2002, 2003 Ben Wing.
 
 ;; Copyright (C) 1997 Free Software Foundation, Inc.
 ;; Copyright (C) 2002, 2003 Ben Wing.
+;; Copyright (C) 2004 - 2015 Steve Youngs
 
 ;; Author: Steven L Baur <steve@xemacs.org>
 
 ;; Author: Steven L Baur <steve@xemacs.org>
-;; Maintainer: Steven L Baur <steve@xemacs.org>
+;; Maintainer: Steve Youngs <steve@sxemacs.org>
 ;; Keywords: internal, lisp, dumped
 
 ;; This file is part of SXEmacs.
 ;; Keywords: internal, lisp, dumped
 
 ;; This file is part of SXEmacs.
 (defvar last-package-load-path nil
   "Load path for packages last in the load path.")
 
 (defvar last-package-load-path nil
   "Load path for packages last in the load path.")
 
-(defun packages-compute-package-locations (user-init-directory)
+(defun packages-find-user-topdir ()
+  "Return the top of the user's local package hierachy.
+
+This should be the equivalent of `$XDG_DATA_HOME/sxemacs'.  But will
+fall back to the old legacy directory, `~/.sxemacs', if that is the
+value of `user-init-directory'.  It may also be in the location set
+via the `-user-pkgs-directory' command line arg."
+  (let* ((legacy (getenv "SXE_USE_LEGACY"))
+        (xdg (getenv "XDG_DATA_HOME"))
+        (xdgdir (or (and xdg
+                         (paths-construct-path `(,xdg "sxemacs")))
+                    (paths-construct-path
+                     `(,(user-home-directory)
+                           ".local" "share" "sxemacs"))))
+        warndirs)
+    ;; Set it, if not already.
+    (when (null user-packages-topdir)
+      (if (or legacy
+             (string= (expand-file-name "~/.sxemacs")
+                      (expand-file-name user-init-directory)))
+         (setq user-packages-topdir user-init-directory)
+       (setq user-packages-topdir (file-name-as-directory xdgdir))))
+    ;; Create if needed.
+    (unless (paths-file-readable-directory-p user-packages-topdir)
+      (make-directory-path user-packages-topdir))
+    ;; Warn if a user has pkg dirs in 2 or more of ~/.sxemacs,
+    ;; XDG_CONFIG_HOME, XDG_DATA_HOME, but not for symlinked dirs.
+    (let* ((regexp #r"\(s?xemacs\|site\|mule\)-packages")
+          (cpkgd (or (and (getenv "XDG_CONFIG_HOME")
+                          (paths-construct-path
+                           `(,(getenv "XDG_CONFIG_HOME") "sxemacs")))
+                     (paths-construct-path
+                      `(,(user-home-directory) ".config" "sxemacs")))))
+      ;; ~/.sxemacs
+      (when (and (not (file-symlink-p "~/.sxemacs"))
+                (file-directory-p "~/.sxemacs")
+                (directory-files "~/.sxemacs" nil regexp nil 'subdir))
+       (push "~/.sxemacs" warndirs))
+      ;; XDG_DATA_HOME
+      (when (and (not (file-symlink-p xdgdir))
+                (file-directory-p xdgdir)
+                (directory-files xdgdir nil regexp nil 'subdir))
+       (push xdgdir warndirs))
+      ;; XDG_CONFIG_HOME
+      (when (and (not (file-symlink-p cpkgd))
+                (file-directory-p cpkgd)
+                (directory-files cpkgd nil regexp nil 'subdir))
+       (push cpkgd warndirs))
+      (when (> (length warndirs) 1)
+       (lwarn 'multi-pkgd nil
+         "Multiple user package hierarchies detected!!
+
+The following directories contain what appears to be package subdirs:
+%S.
+
+Currently in use: `%s'
+
+This, in itself, is not necessarily a problem, but it may mean that
+some of your packages won't be visible to this SXEmacs instance.  You
+should keep all of your local packages in a single location.
+
+See `display-warning-suppressed-classes' to suppress this warning"
+         warndirs user-packages-topdir)))
+    ;; Return the dir
+    user-packages-topdir))
+
+(defun packages-compute-package-locations (user-packages-topdir)
   "Compute locations of the various package directories.
   "Compute locations of the various package directories.
-This is a list each of whose elements describes one directory.
-A directory description is a three-element list.
+
+Argument USER-PACKAGES-TOPDIR is the top of the user's local package
+hierarchy.  It would normally be the equivalent of
+`$XDG_DATA_HOME/sxemacs'.
+
+This is a list, each of whose elements describes one directory.  A
+directory description is a three-element list.
+
 The first element is either an absolute path or a subdirectory
 in the XEmacs hierarchy.
 The first element is either an absolute path or a subdirectory
 in the XEmacs hierarchy.
-The second component is one of the symbols EARLY, LATE, LAST,
+
+The second element is one of the symbols EARLY, LATE, LAST,
 depending on the load-path segment the hierarchy is supposed to
 show up in.
 depending on the load-path segment the hierarchy is supposed to
 show up in.
-The third component is a thunk which, if it returns NIL, causes
-the directory to be ignored."
+
+The third element is a thunk which, if it returns NIL, causes the
+directory to be ignored."
   (list
   (list
-   (list (paths-construct-path (list user-init-directory "site-packages"))
+   (list (paths-construct-path (list user-packages-topdir "site-packages"))
         'early #'(lambda () t))
         'early #'(lambda () t))
-   (list (paths-construct-path (list user-init-directory "sxemacs-packages"))
+   (list (paths-construct-path (list user-packages-topdir "sxemacs-packages"))
         'early #'(lambda () t))
         'early #'(lambda () t))
-   (list (paths-construct-path (list user-init-directory "infodock-packages"))
+   (list (paths-construct-path (list user-packages-topdir "infodock-packages"))
         'early #'(lambda () (featurep 'infodock)))
         'early #'(lambda () (featurep 'infodock)))
-   (list (paths-construct-path (list user-init-directory "mule-packages"))
+   (list (paths-construct-path (list user-packages-topdir "mule-packages"))
         'early #'(lambda () (featurep 'mule)))
         'early #'(lambda () (featurep 'mule)))
-   (list (paths-construct-path (list user-init-directory "xemacs-packages"))
+   (list (paths-construct-path (list user-packages-topdir "xemacs-packages"))
         'early #'(lambda () t))
    (list "site-packages"     'late  #'(lambda () t))
    (list "sxemacs-packages"  'late  #'(lambda () t))
         'early #'(lambda () t))
    (list "site-packages"     'late  #'(lambda () t))
    (list "sxemacs-packages"  'late  #'(lambda () t))
index f7b5aef..a58eca7 100644 (file)
@@ -260,6 +260,8 @@ In addition, the")
   -q                    Same as -no-init-file.
   -user-init-file <file> Use <file> as init file.
   -user-init-directory <directory> Use <directory> as init directory.
   -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")
   -user <user>          Load user's init file instead of your own.
                         Probably not a wise thing to do.
   -u <user>             Same as -user.\n")
@@ -564,13 +566,19 @@ Internal variable, DO NOT USE.")
               (home-user (concat "~" user))
               (xdgdir (paths-construct-path
                        (list home-user ".config" "sxemacs")))
               (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))
               (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))))
+                            (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 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))
          (setq user-init-file
                (find-user-init-file user-init-directory))
          (setq custom-file (make-custom-file-name user-init-file))
@@ -1181,6 +1189,11 @@ idempotent, so call this as often as you like!"
            (princ (format "lisp-initd-dir:\n\%S\n" lisp-initd-dir)
                   'external-debugging-output)))))
   ;; Packages
            (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))
   (apply #'(lambda (early late last)
             (setq early-packages (and (not inhibit-early-packages)
                                       early))
@@ -1188,7 +1201,7 @@ 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 userdir)))
+         (packages-compute-package-locations user-packages-topdir)))
 
   (setq early-package-load-path
        (packages-find-package-load-path early-packages)
 
   (setq early-package-load-path
        (packages-find-package-load-path early-packages)
index 0517f8c..8feec5d 100644 (file)
@@ -3,7 +3,7 @@
    Free Software Foundation, Inc.
    Copyright (C) 1995 Sun Microsystems, Inc.
    Copyright (C) 2000, 2002 Ben Wing.
    Free Software Foundation, Inc.
    Copyright (C) 1995 Sun Microsystems, Inc.
    Copyright (C) 2000, 2002 Ben Wing.
-   Copyright (C) 2004 Steve Youngs.
+   Copyright (C) 2004, 2015 Steve Youngs.
 
 This file is part of SXEmacs
 
 
 This file is part of SXEmacs
 
@@ -309,7 +309,7 @@ Lisp_Object Vconfigure_info_directory;
 Lisp_Object Vconfigure_info_path;
 Lisp_Object Vinternal_error_checking;
 Lisp_Object Vmail_lock_methods, Vconfigure_mail_lock_method;
 Lisp_Object Vconfigure_info_path;
 Lisp_Object Vinternal_error_checking;
 Lisp_Object Vmail_lock_methods, Vconfigure_mail_lock_method;
-Lisp_Object Vpath_separator;
+Lisp_Object Vpath_separator, Vuser_packages_topdir;
 
 /* The default base directory SXEmacs is installed under. */
 Lisp_Object Vconfigure_exec_prefix_directory, Vconfigure_prefix_directory;
 
 /* The default base directory SXEmacs is installed under. */
 Lisp_Object Vconfigure_exec_prefix_directory, Vconfigure_prefix_directory;
@@ -333,6 +333,12 @@ int display_arg;
    variable. */
 const char *display_use;
 
    variable. */
 const char *display_use;
 
+/* Directory specified on the command line for user packages
+   (early-packages).  We cannot use a Lisp symbol here because Lisp
+   symbols may not be initialised at the time that we set this. */
+const char *user_pkgd;
+int upkgd = 0;
+
 /* If non-zero, then the early error handler will only print the error
    message and exit. */
 int suppress_early_error_handler_backtrace;
 /* If non-zero, then the early error handler will only print the error
    message and exit. */
 int suppress_early_error_handler_backtrace;
@@ -1115,6 +1121,14 @@ DOESNT_RETURN main_1(int argc, char **argv, char **envp, int restart)
                     11, NULL, &skip_args))
                debug_paths = 1;
 
                     11, NULL, &skip_args))
                debug_paths = 1;
 
+       /* Handle -user-pkgs-directory */
+       char *pkgd;
+       if (argmatch(argv, argc, "-user-pkgs-directory", "--user-pkgs-directory",
+                    11, &pkgd, &skip_args)) {
+               user_pkgd = pkgd;
+               upkgd = 1;
+       }
+
        /* Partially handle -no-autoloads, -no-early-packages and -vanilla.
           Packages */
        /* are searched prior to the rest of the command line being parsed in */
        /* Partially handle -no-autoloads, -no-early-packages and -vanilla.
           Packages */
        /* are searched prior to the rest of the command line being parsed in */
@@ -2176,6 +2190,14 @@ DOESNT_RETURN main_1(int argc, char **argv, char **envp, int restart)
           of this stuff involves querying the current environment and needs
           to be done both at dump time and at run time. */
 
           of this stuff involves querying the current environment and needs
           to be done both at dump time and at run time. */
 
+       /* user-packages-topdir (early-packages) */
+       if (upkgd == 0) {
+               Vuser_packages_topdir = Qnil;
+       } else {
+               Vuser_packages_topdir = Ffile_name_as_directory
+                       (build_string(user_pkgd));
+       }
+
        init_initial_directory();       /* get the directory to use for the
                                           "*scratch*" buffer, etc. */
 
        init_initial_directory();       /* get the directory to use for the
                                           "*scratch*" buffer, etc. */
 
@@ -2330,6 +2352,10 @@ static const struct standard_args standard_args[] = {
        {"-no-autoloads", "--no-autoloads", 50, 0},
        {"-no-site-file", "--no-site-file", 40, 0},
        {"-no-early-packages", "--no-early-packages", 35, 0},
        {"-no-autoloads", "--no-autoloads", 50, 0},
        {"-no-site-file", "--no-site-file", 40, 0},
        {"-no-early-packages", "--no-early-packages", 35, 0},
+       /* -user-pkgs-directory is actually handled in main_1() and
+          not in startup.el.  It is listed here because of the
+          priority given to this arg. */
+       {"-user-pkgs-directory", "--user-pkgs-directory", 30, 1},
        {"-u", "--user", 30, 1},
        {"-user", 0, 30, 1},
        {"-debug-init", "--debug-init", 20, 0},
        {"-u", "--user", 30, 1},
        {"-user", 0, 30, 1},
        {"-debug-init", "--debug-init", 20, 0},
@@ -3465,6 +3491,12 @@ Set to non-nil when site-modules should not be searched at startup.
        inhibit_site_modules = 1;
 #endif
 
        inhibit_site_modules = 1;
 #endif
 
+       DEFVAR_LISP("user-packages-topdir", &Vuser_packages_topdir /*
+Top of the user's local package hierarchy.
+This is normally computed at run-time, but may be set via the
+`-user-pkgs-directory' command line argument.
+                                                                  */ );
+
        DEFVAR_INT("emacs-priority", &emacs_priority /*
 Priority for SXEmacs to run at.
 This value is effective only if set before SXEmacs is dumped,
        DEFVAR_INT("emacs-priority", &emacs_priority /*
 Priority for SXEmacs to run at.
 This value is effective only if set before SXEmacs is dumped,