From: Steve Youngs Date: Thu, 4 Jun 2015 13:36:25 +0000 (+1000) Subject: XDG Compliant user (early) packages tree. X-Git-Tag: v22.1.16~45^2~1 X-Git-Url: https://cgit.sxemacs.org/?a=commitdiff_plain;h=30e80ecbf0baf6d0bed7780ee90cfa1859546f4f;p=sxemacs XDG Compliant user (early) packages tree. 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 --- diff --git a/lisp/package-admin.el b/lisp/package-admin.el index 09aeee7..8b8112f 100644 --- a/lisp/package-admin.el +++ b/lisp/package-admin.el @@ -1,7 +1,7 @@ ;;; 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 ;; Keywords: internal @@ -130,7 +130,7 @@ to BUFFER." (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. @@ -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 -`user-init-directory'. This overrides everything except +`user-packages-topdir'. This overrides everything except \"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))))))) - ;; 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 - (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 - (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 - (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 - (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 - (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 @@ -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 -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 -`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, - ;; that means in `user-init-directory'. + ;; that means in `user-packages-topdir'. (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))) @@ -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. - ;; 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? " - user-init-directory)) + user-packages-topdir)) (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"))) - ;; 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. - (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. :-( diff --git a/lisp/package-get.el b/lisp/package-get.el index f858729..426f826 100644 --- a/lisp/package-get.el +++ b/lisp/package-get.el @@ -2,7 +2,7 @@ ;; 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 ;; Heavy-Modifications: Greg Klanderman @@ -169,17 +169,20 @@ one version of a package available.") ;;;###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 -(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) +(defvaralias 'package-get-install-to-user-init-directory + 'package-get-install-to-user-directory) + (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? " - location user-init-directory)) + location user-packages-topdir)) (setq location (expand-file-name package-get-base-filename package-get-package-index-file-location)) diff --git a/lisp/packages.el b/lisp/packages.el index e401b03..881ad12 100644 --- a/lisp/packages.el +++ b/lisp/packages.el @@ -2,9 +2,10 @@ ;; Copyright (C) 1997 Free Software Foundation, Inc. ;; Copyright (C) 2002, 2003 Ben Wing. +;; Copyright (C) 2004 - 2015 Steve Youngs ;; Author: Steven L Baur -;; Maintainer: Steven L Baur +;; Maintainer: Steve Youngs ;; Keywords: internal, lisp, dumped ;; This file is part of SXEmacs. @@ -83,27 +84,101 @@ (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. -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 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. -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 (paths-construct-path (list user-init-directory "site-packages")) + (list (paths-construct-path (list user-packages-topdir "site-packages")) '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)) - (list (paths-construct-path (list user-init-directory "infodock-packages")) + (list (paths-construct-path (list user-packages-topdir "infodock-packages")) '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))) - (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)) diff --git a/lisp/startup.el b/lisp/startup.el index f7b5aef..a58eca7 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -260,6 +260,8 @@ In addition, the") -q Same as -no-init-file. -user-init-file Use as init file. -user-init-directory Use as init directory. + -user-pkgs-directory Use as the top of the local (early) + packages tree. -user Load user's init file instead of your own. Probably not a wise thing to do. -u 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"))) + (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)))) + (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)) @@ -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 + (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)) @@ -1188,7 +1201,7 @@ idempotent, so call this as often as you like!" (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) diff --git a/src/emacs.c b/src/emacs.c index 0517f8c..8feec5d 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -3,7 +3,7 @@ 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 @@ -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 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; @@ -333,6 +333,12 @@ int display_arg; 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; @@ -1115,6 +1121,14 @@ DOESNT_RETURN main_1(int argc, char **argv, char **envp, int restart) 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 */ @@ -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. */ + /* 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. */ @@ -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}, + /* -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}, @@ -3465,6 +3491,12 @@ Set to non-nil when site-modules should not be searched at startup. 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,