;;; 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
(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.
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\"
"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
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)))
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)))
(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. :-(
;; 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>
;;;###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")
(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))
;; 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>
-;; Maintainer: Steven L Baur <steve@xemacs.org>
+;; Maintainer: Steve Youngs <steve@sxemacs.org>
;; 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.")
-(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))
-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")
(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))
(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 userdir)))
+ (packages-compute-package-locations user-packages-topdir)))
(setq early-package-load-path
(packages-find-package-load-path early-packages)
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
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;
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;
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 */
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. */
{"-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},
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,
projects / sxemacs / commitdiff