Mercurial > hg > xemacs-beta
changeset 2456:f4e405a9d18d
[xemacs-hg @ 2004-12-27 12:25:14 by michaels]
2004-12-18 Mike Sperber <mike@xemacs.org>
* package-admin.el:
* startup.el: Reflect the changes made in packages.el.
* packages.el:
* loadup.el:
* make-docfile.el:
* package-admin.el:
* startup.el:
* update-elc.el (early-package-hierarchies)
(late-package-hierarchies)
(last-package-hierarchies): Renamed these from `early-packages',
`late-packages' and `last-packages'.
* packages.el: Rewrote package-finding logic to separate the
concepts of "package directories" and "package hierarchies".
Added explanation of these concepts.
* setup-paths.el:
* find-paths.el: Added parameter descriptions to some of the
docstrings.
* packages.el, setup-paths.el: Make terminology more explicit
about "package hierarchies"
* startup.el (emacs-roots, emacs-data-roots)
(user-init-directory-base, user-init-directory)
(user-init-file-base, user-init-file-base-list)
(user-home-init-file-base-list)
(load-home-init-file, load-user-init-file-p)
(startup-find-load-path, startup-setup-paths)
(startup-find-load-path-for-packages): Moved these back from
setup-paths.el where they belong---setup-paths.el now again, as
documented, contains no code that sets global variables. (They
were moved from startup.el to setup-paths.el on 2003-02-28.)
Clarify that in the comment at the top.
* setup-paths.el (paths-find-emacs-roots): Restored
`invocation-directory' 'invocation-name' parameters removed on
2003-02-28; they're useful for debugging.
author | michaels |
---|---|
date | Mon, 27 Dec 2004 12:27:05 +0000 |
parents | 3e06061baa0e |
children | 287e4d41dc7f |
files | lisp/ChangeLog lisp/find-paths.el lisp/loadup.el lisp/make-docfile.el lisp/package-admin.el lisp/packages.el lisp/setup-paths.el lisp/startup.el lisp/update-elc.el |
diffstat | 9 files changed, 526 insertions(+), 424 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Sun Dec 26 22:52:34 2004 +0000 +++ b/lisp/ChangeLog Mon Dec 27 12:27:05 2004 +0000 @@ -1,3 +1,45 @@ +2004-12-18 Mike Sperber <mike@xemacs.org> + + * package-admin.el: + * startup.el: Reflect the changes made in packages.el. + + * packages.el: + * loadup.el: + * make-docfile.el: + * package-admin.el: + * startup.el: + * update-elc.el (early-package-hierarchies) + (late-package-hierarchies) + (last-package-hierarchies): Renamed these from `early-packages', + `late-packages' and `last-packages'. + + * packages.el: Rewrote package-finding logic to separate the + concepts of "package directories" and "package hierarchies". + Added explanation of these concepts. + + * setup-paths.el: + * find-paths.el: Added parameter descriptions to some of the + docstrings. + + * packages.el, setup-paths.el: Make terminology more explicit + about "package hierarchies" + + * startup.el (emacs-roots, emacs-data-roots) + (user-init-directory-base, user-init-directory) + (user-init-file-base, user-init-file-base-list) + (user-home-init-file-base-list) + (load-home-init-file, load-user-init-file-p) + (startup-find-load-path, startup-setup-paths) + (startup-find-load-path-for-packages): Moved these back from + setup-paths.el where they belong---setup-paths.el now again, as + documented, contains no code that sets global variables. (They + were moved from startup.el to setup-paths.el on 2003-02-28.) + Clarify that in the comment at the top. + + * setup-paths.el (paths-find-emacs-roots): Restored + `invocation-directory' 'invocation-name' parameters removed on + 2003-02-28; they're useful for debugging. + 2004-12-15 Ville Skyttä <scop@xemacs.org> * bytecomp-runtime.el (make-obsolete): Add 3rd argument (no-op for
--- a/lisp/find-paths.el Sun Dec 26 22:52:34 2004 +0000 +++ b/lisp/find-paths.el Mon Dec 27 12:27:05 2004 +0000 @@ -5,7 +5,7 @@ ;; Copyright (C) 1995 Board of Trustees, University of Illinois ;; Copyright (C) 2003 Ben Wing. -;; Author: Mike Sperber <sperber@informatik.uni-tuebingen.de> +;; Author: Mike Sperber <mike@xemacs.org> ;; Maintainer: XEmacs Development Team ;; Keywords: internal, dumped @@ -125,7 +125,10 @@ path))) (defun paths-construct-emacs-directory (root suffix base) - "Construct a directory name within the XEmacs hierarchy." + "Construct a directory name within the XEmacs hierarchy. +ROOT must be a an installation root. +SUFFIX is the subdirectory from there. +BASE is the base to look for." (file-name-as-directory (expand-file-name (concat @@ -165,7 +168,12 @@ nil)))) (defun paths-find-site-directory (roots base &optional envvar default) - "Find a site-specific directory in the XEmacs hierarchy." + "Find a site-specific directory in the XEmacs hierarchy. +ROOT must be a an installation root. +BASE is the base to look for. +ENVVAR is the name of the environment variable that might also +specify the directory. +DEFAULT is the preferred value." (paths-find-emacs-directory roots (file-name-as-directory (paths-construct-path (list @@ -177,6 +185,12 @@ (defun paths-find-version-directory (roots base &optional envvar default enforce-version) "Find a version-specific directory in the XEmacs hierarchy. + +ROOT must be a an installation root. +BASE is the base to look for. +ENVVAR is the name of the environment variable that might also +specify the directory. +DEFAULT is the preferred value. If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version." (paths-find-emacs-directory roots (file-name-as-directory @@ -188,7 +202,12 @@ enforce-version)) (defun paths-find-architecture-directory (roots base &optional envvar default) - "Find an architecture-specific directory in the XEmacs hierarchy." + "Find an architecture-specific directory in the XEmacs hierarchy. +ROOT must be a an installation root. +BASE is the base to look for. +ENVVAR is the name of the environment variable that might also +specify the directory. +DEFAULT is the preferred value." (or ;; from more to less specific (paths-find-version-directory roots @@ -203,11 +222,12 @@ envvar))) (defun construct-emacs-version-name () - "Construct the raw XEmacs version number." + "Construct a string from the raw XEmacs version number." (concat emacs-program-name "-" emacs-program-version)) (defun paths-directories-which-exist (directories) - "Return the directories among DIRECTORIES." + "Return the directories among DIRECTORIES. +DIRECTORIES is a list of strings." (let ((reverse-directories '())) (while directories (if (paths-file-readable-directory-p (car directories)) @@ -218,7 +238,7 @@ (reverse reverse-directories))) (defun paths-uniq-append (list-1 list-2) - "Append LIST-1 and LIST-2, omitting duplicates." + "Append LIST-1 and LIST-2, omitting EQUAL duplicates." (let ((reverse-survivors '())) (while list-2 (if (null (member (car list-2) list-1))
--- a/lisp/loadup.el Sun Dec 26 22:52:34 2004 +0000 +++ b/lisp/loadup.el Mon Dec 27 12:27:05 2004 +0000 @@ -139,7 +139,7 @@ (external-debugging-output (format "\nLoad file %s: not found\n" file)) ;; Uncomment in case of trouble - ;;(print (format "late-packages: %S" late-packages)) + ;;(print (format "late-package-hierarchies: %S" late-package-hierarchies)) ;;(print (format "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name #'paths-emacs-root-p))) ;;(print (format "guessed-data-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name #'paths-emacs-data-root-p))) nil)))
--- a/lisp/make-docfile.el Sun Dec 26 22:52:34 2004 +0000 +++ b/lisp/make-docfile.el Mon Dec 27 12:27:05 2004 +0000 @@ -170,7 +170,7 @@ (progn (message "Error: dumped file %s does not exist" arg0) ;; Uncomment in case of difficulties - ;;(message "late-packages: %S" late-packages) + ;;(message "late-package-hierarchies: %S" late-package-hierarchies) ;;(message "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name #'paths-emacs-root-p)) ;;(message "guessed-data-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name #'paths-emacs-data-root-p)) )
--- a/lisp/package-admin.el Sun Dec 26 22:52:34 2004 +0000 +++ b/lisp/package-admin.el Mon Dec 27 12:27:05 2004 +0000 @@ -197,9 +197,8 @@ (expand-file-name "mule-packages" user-init-directory)))))) ;; Finally check the normal places (if (not top-dir) - (let ((path-list (nth 1 (packages-find-packages - emacs-data-roots - (packages-compute-package-locations user-init-directory))))) + (let ((path-list (nth 1 (packages-find-all-package-hierarchies + emacs-data-roots)))) (cond ((eq type 'std) (while path-list (if (equal (substring (car path-list) -16) @@ -226,7 +225,7 @@ see if the PACKAGE is already installed and return that location, if it is writable. Finally, fall back to the `user-init-directory' if all else fails. As a side effect of installing packages under -`user-init-directory' these packages become part of `early-packages'." +`user-init-directory' these packages become part of `early-package-hierarchies'." ;; If pkg-dir specified, return that if writable. (if (and pkg-dir (file-writable-p (directory-file-name pkg-dir))) @@ -255,7 +254,7 @@ (car-safe (member-if (lambda (h) (string-match (concat "^" (regexp-quote h)) autoload-dir)) - (append (cdr early-packages) late-packages))))) + (append (cdr early-package-hierarchies) late-package-hierarchies))))) (if (and pkg-dir (file-writable-p (directory-file-name pkg-dir))) pkg-dir
--- a/lisp/packages.el Sun Dec 26 22:52:34 2004 +0000 +++ b/lisp/packages.el Mon Dec 27 12:27:05 2004 +0000 @@ -58,8 +58,25 @@ (defvar packages-package-list nil "Database of installed packages and version numbers") -(defvar packages-hierarchy-depth 1 - "Depth of package hierarchies.") +;;; Directories and paths + +;;; Terminology: + +;;; A *package hierarchy* is a directory that contains a collection of +;;; packages; it has lisp/, info/, etc/ etc. subdirectories that +;;; contain the files constituting the packages. + +;;; A *package directory* contains package hierarchies---the package +;;; hierarchies are typically in directories "xemacs-packages", +;;; "mule-packages", and so on. A package hierarchy might only be +;;; applicable for specific variants of XEmacs. + +;;; Package hierarchies come in "early", "late", and "last" variants, +;;; depending on their relative location in the various paths. +;;; "Early" hierarchies are typically in the user's home directory, +;;; "late" hierarchies are typically part of the XEmacs installation, +;;; and "last" package hierarchies are for special purposes, such as +;;; making the packages of some previous XEmacs version available. (defvar packages-load-path-depth 1 "Depth of load-path search in package hierarchies.") @@ -67,48 +84,33 @@ (defvar packages-data-path-depth 1 "Depth of data-path search in package hierarchies.") -(defvar early-packages nil - "Packages early in the load path.") +(defvar early-package-hierarchies nil + "Package hierarchies early in the load path.") (defvar early-package-load-path nil "Load path for packages early in the load path.") -(defvar late-packages nil - "Packages late in the load path.") +(defvar late-package-hierarchies nil + "Package hierarchies late in the load path.") (defvar late-package-load-path nil "Load path for packages late in the load path.") -(defvar last-packages nil - "Packages last in the load path.") +(defvar last-package-hierarchies nil + "Package hierarchies 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) - "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. -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, -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." - (list - (list (paths-construct-path (list user-init-directory "site-packages")) - 'early #'(lambda () t)) - (list (paths-construct-path (list user-init-directory "infodock-packages")) - 'early #'(lambda () (featurep 'infodock))) - (list (paths-construct-path (list user-init-directory "mule-packages")) - 'early #'(lambda () (featurep 'mule))) - (list (paths-construct-path (list user-init-directory "xemacs-packages")) - 'early #'(lambda () t)) - (list "site-packages" 'late #'(lambda () t)) - (list "infodock-packages" 'late #'(lambda () (featurep 'infodock))) - (list "mule-packages" 'late #'(lambda () (featurep 'mule))) - (list "xemacs-packages" 'late #'(lambda () t)))) +(defun packages-package-hierarchy-directory-names () + "Returns a list package hierarchy directory names. +These are the valid immediate directory names of package +directories, directories with higher priority first" + (paths-filter #'(lambda (x) x) + `("site-packages" + ,(when (featurep 'infodock) "infodock-packages") + ,(when (featurep 'mule) "mule-packages") + "xemacs-packages"))) (defun package-get-key-1 (info key) "Locate keyword `key' in list." @@ -328,30 +330,15 @@ ;; Path setup -(defun packages-find-package-directories (roots base) - "Find a set of package directories." - ;; make sure paths-find-version-directory and paths-find-site-directory - ;; don't both pick up version-independent directories ... - (let ((version-directory (paths-find-version-directory roots base nil nil t)) - (site-directory (paths-find-site-directory roots base))) - (paths-uniq-append - (and version-directory (list version-directory)) - (and site-directory (list site-directory))))) - -(defvar packages-special-base-regexp "^\\(etc\\|info\\|man\\|lisp\\|lib-src\\|bin\\|pkginfo\\)$" - "Special subdirectories of packages.") - -(defvar packages-no-package-hierarchy-regexp - (concat "\\(" paths-version-control-filename-regexp "\\)" - "\\|" - "\\(" packages-special-base-regexp "\\)") - "Directories which can't be the roots of package hierarchies.") - -(defun packages-find-packages-in-directories (directories) - "Find all packages underneath directories in DIRECTORIES." - (paths-find-recursive-path directories - packages-hierarchy-depth - packages-no-package-hierarchy-regexp)) +(defun packages-find-package-hierarchies-named (package-directories base) + "Find a set of package hierarchies within an XEmacs installation. +PACKAGE-DIRECTORIES is a list of package directories. +BASE is a subdirectory name for the hierarchy. +Returns list of hierarchies." + (paths-directories-which-exist + (mapcar #'(lambda (package-directory) + (file-name-as-directory (concat package-directory base))) + package-directories))) (defun packages-split-path (path) "Split PATH at \"\", return pair with two components. @@ -368,7 +355,8 @@ (defun packages-split-package-path (package-path) "Split up PACKAGE-PATH into early, late and last components. The separation is by \"\" components. -This returns (LIST EARLY-PACKAGES LATE-PACKAGES LAST-PACKAGES)." +This returns +(LIST EARLY-PACKAGE-HIERARCHIES LATE-PACKAGE-HIERARCHIES LAST-PACKAGE-HIERARCHIES)." ;; When in doubt, it's late (let* ((stuff (packages-split-path package-path)) (early (and (cdr stuff) (car stuff))) @@ -376,99 +364,102 @@ (stuff (packages-split-path late+last)) (late (car stuff)) (last (cdr stuff))) - (list (packages-find-packages-in-directories early) - (packages-find-packages-in-directories late) - (packages-find-packages-in-directories last)))) + (list (mapcar #'file-name-as-directory early) + (mapcar #'file-name-as-directory late) + (mapcar #'file-name-as-directory last)))) (defun packages-deconstruct (list consumer) - "Deconstruct LIST and feed it to CONSUMER." + "Deconstruct LIST and feed it to CONSUMER. +CONSUMER is a function that accepts the elements of LISTS as separate arguments." (apply consumer list)) -(defun packages-find-packages-by-name (roots name) - "Find a package hierarchy by its name." - (packages-find-packages-in-directories - (if (and (file-name-absolute-p name) - (file-name-directory (expand-file-name name))) - (list (file-name-as-directory (expand-file-name name))) - (packages-find-package-directories roots name)))) +(defun packages-find-installation-package-directories (roots) + "Find the package directories in the XEmacs installation. +ROOTS is a list of installation roots." + (let ((version-directory (paths-find-version-directory roots "" nil nil t)) + (site-directory (paths-find-site-directory roots ""))) + (paths-uniq-append + (and version-directory (list version-directory)) + (and site-directory (list site-directory))))) -(defun packages-find-packages-at-time - (roots package-locations time &optional default) - "Find packages at given time. -For the format of PACKAGE-LOCATIONS, see the global variable of the same name. -TIME is either 'EARLY, 'LATE, or 'LAST. -DEFAULT is a default list of packages." +(defun packages-find-package-hierarchies (package-directories &optional default) + "Find package hierarchies in a list of package directories. +PACKAGE-DIRECTORIES is a list of package directories. +DEFAULT is a default list of package hierarchies." (or default - (let ((packages '())) - (while package-locations - (packages-deconstruct - (car package-locations) - #'(lambda (name a-time thunk) - (if (and (eq time a-time) - (funcall thunk)) - (setq packages - (nconc packages - (packages-find-packages-by-name roots name)))))) - (setq package-locations (cdr package-locations))) - packages))) - -(defun packages-find-packages (roots package-locations) - "Find the packages." + (let ((package-hierarchies '()) + (hierarchy-directories (packages-package-hierarchy-directory-names))) + (while hierarchy-directories + (setq package-hierarchies + (nconc package-hierarchies + (packages-find-package-hierarchies-named + package-directories + (car hierarchy-directories)))) + (setq hierarchy-directories (cdr hierarchy-directories))) + package-hierarchies))) + +(defun packages-find-all-package-hierarchies (roots) + "Find the package hierarchies. +ROOTS is a list of installation roots. +Returns a list of three directory lists, the first being the list of early +hierarchies, the second that of the late hierarchies, and the third the +list of the last hierarchies." (let ((envvar-value (getenv "EMACSPACKAGEPATH"))) (if envvar-value (packages-split-package-path (paths-decode-directory-path envvar-value)) (packages-deconstruct (packages-split-package-path configure-package-path) - #'(lambda (configure-early-packages - configure-late-packages - configure-last-packages) - (list (packages-find-packages-at-time roots package-locations 'early - configure-early-packages) - (packages-find-packages-at-time roots package-locations 'late - configure-late-packages) - (packages-find-packages-at-time roots package-locations 'last - configure-last-packages))))))) + #'(lambda (configure-early-package-hierarchies + configure-late-package-hierarchies + configure-last-package-hierarchies) + (list + (packages-find-package-hierarchies (list user-init-directory) + configure-early-package-hierarchies) + (packages-find-package-hierarchies (packages-find-installation-package-directories roots) + configure-late-package-hierarchies) + (packages-find-package-hierarchies '() + configure-last-package-hierarchies))))))) -(defun packages-find-package-library-path (packages suffixes) +(defun packages-find-package-library-path (package-hierarchies suffixes) "Construct a path into a component of the packages hierarchy. -PACKAGES is a list of package directories. -SUFFIXES is a list of names of package subdirectories to look for." +PACKAGE-HIERARCHIES is a list of package hierarchies. +SUFFIXES is a list of names of hierarchy subdirectories to look for." (let ((directories (apply #'nconc - (mapcar #'(lambda (package) + (mapcar #'(lambda (hierarchy) (mapcar #'(lambda (suffix) - (file-name-as-directory (concat package suffix))) + (file-name-as-directory (concat hierarchy suffix))) suffixes)) - packages)))) + package-hierarchies)))) (paths-directories-which-exist directories))) -(defun packages-find-package-load-path (packages) +(defun packages-find-package-load-path (package-hierarchies) "Construct the load-path component for packages. -PACKAGES is a list of package directories." +PACKAGE-HIERARCHIES is a list of package hierarchies." (paths-find-recursive-load-path - (packages-find-package-library-path packages + (packages-find-package-library-path package-hierarchies '("lisp")) packages-load-path-depth)) -(defun packages-find-package-exec-path (packages) +(defun packages-find-package-exec-path (package-hierarchies) "Construct the exec-path component for packages. -PACKAGES is a list of package directories." - (packages-find-package-library-path packages +PACKAGE-HIERARCHIES is a list of package hierarchies." + (packages-find-package-library-path package-hierarchies (list (paths-construct-path (list "bin" system-configuration)) "lib-src"))) -(defun packages-find-package-info-path (packages) +(defun packages-find-package-info-path (package-hierarchies) "Construct the info-path component for packages. -PACKAGES is a list of package directories." - (packages-find-package-library-path packages '("info"))) +PACKAGE-HIERARCHIES is a list of package directories." + (packages-find-package-library-path package-hierarchies '("info"))) -(defun packages-find-package-data-path (packages) +(defun packages-find-package-data-path (package-hierarchies) "Construct the data-path component for packages. -PACKAGES is a list of package directories." +PACKAGE-HIERARCHIES is a list of package hierachies." (paths-find-recursive-load-path - (packages-find-package-library-path packages + (packages-find-package-library-path package-hierarchies '("etc")) packages-data-path-depth))
--- a/lisp/setup-paths.el Sun Dec 26 22:52:34 2004 +0000 +++ b/lisp/setup-paths.el Mon Dec 27 12:27:05 2004 +0000 @@ -5,7 +5,7 @@ ;; Copyright (C) 1995 Board of Trustees, University of Illinois ;; Copyright (C) 2003 Ben Wing. -;; Author: Mike Sperber <sperber@informatik.uni-tuebingen.de> +;; Author: Mike Sperber <mike@xemacs.orgx> ;; Maintainer: XEmacs Development Team ;; Keywords: internal, dumped @@ -34,7 +34,10 @@ ;; This file contains functions and variables that describe and construct ;; the various paths into the XEmacs hierarchy from a global viewpoint. -;; This file doesn't actually do anything. + +;; This file doesn't actually set any global variable, and doesn't +;; contain any state---it just contains the functionality for +;; searching directories and constructing paths. ;; It requires find-paths.el and packages.el. @@ -43,51 +46,6 @@ ;(setq debug-paths t) -;;; Path-related variables. -;;; NOTE: Many of them (`lisp-directory', `data-directory', etc.) are -;;; built-in. - -(defvar emacs-roots nil - "List of plausible roots of the XEmacs hierarchy. -This is a list of plausible directories in which to search for the important -directories used by XEmacs at run-time, for example `exec-directory', -`data-directory' and `lisp-directory'. - -Normally set at startup by calling `paths-find-emacs-roots'.") - -(defvar emacs-data-roots nil - "List of plausible data roots of the XEmacs hierarchy.") - -(defvar user-init-directory-base ".xemacs" - "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))) - "Directory where user-installed init files may go.") - -(defvar user-init-file-base "init.el" - "Default name of the user init file if uncompiled. -This should be used for migration purposes only.") - -(defvar user-init-file-base-list '("init.el") - "List of allowed init files in the user's init directory. -The first one found takes precedence. .elc files do not need to be listed.") - -(defvar user-home-init-file-base-list - (append '(".emacs.el" ".emacs") - (and (eq system-type 'windows-nt) - '("_emacs.el" "_emacs"))) - "List of allowed init files in the user's home directory. -The first one found takes precedence. .elc files do not need to be listed.") - -(defvar load-home-init-file nil - "Non-nil if XEmacs should load the init file from the home directory. -Otherwise, XEmacs will offer migration to the init directory.") - -(defvar load-user-init-file-p t - "Non-nil if XEmacs should load the user's init file.") - (defvar paths-core-load-path-depth 0 "Depth of load-path searches in core Lisp paths.") @@ -130,7 +88,9 @@ (defun paths-emacs-data-root-p (directory) "Check if DIRECTORY is a plausible data installation root. A data installation root is one containing data files that may be shared -among multiple different versions of XEmacs, the packages in particular." +among multiple different versions of XEmacs, the packages in particular. +This serves as an additional filter to narrow down the list of plausible +installation roots." (or ;; installed (paths-file-readable-directory-p (paths-construct-path (list directory @@ -145,7 +105,9 @@ (paths-file-readable-directory-p (paths-construct-path (list directory "etc")))))) (defun paths-find-emacs-root (invocation-directory invocation-name) - "Find the run-time root of XEmacs." + "Find the run-time root of XEmacs. +INVOCATION-DIRECTORY is a directory containing the XEmacs executable. +INVOCATION-NAME is the name of the executable itself." (let* ((executable-file-name (paths-chase-symlink (concat invocation-directory invocation-name))) @@ -159,7 +121,9 @@ (and (paths-emacs-root-p maybe-root-2) maybe-root-2)))) -(defun paths-find-emacs-roots (root-p) +(defun paths-find-emacs-roots (invocation-directory + invocation-name + root-p) "Find all plausible installation roots for XEmacs. This is a list of plausible directories in which to search for the important directories used by XEmacs at run-time, for example `exec-directory', @@ -184,25 +148,29 @@ installation-roots))) (defun paths-find-site-lisp-directory (roots) - "Find the site Lisp directory of the XEmacs hierarchy." + "Find the site Lisp directory of the XEmacs hierarchy. +ROOTS is a list of installation roots." (paths-find-site-directory roots "site-lisp" nil configure-site-directory)) (defun paths-find-site-module-directory (roots) - "Find the site modules directory of the XEmacs hierarchy." + "Find the site modules directory of the XEmacs hierarchy. +ROOTS is a list of installation roots." (paths-find-site-directory roots "site-modules" nil configure-site-module-directory)) (defun paths-find-lisp-directory (roots) - "Find the main Lisp directory of the XEmacs hierarchy." + "Find the main Lisp directory of the XEmacs hierarchy. +ROOTS is a list of installation roots." (paths-find-version-directory roots "lisp" nil configure-lisp-directory)) (defun paths-find-mule-lisp-directory (roots &optional lisp-directory) - "Find the Mule Lisp directory of the XEmacs hierarchy." + "Find the Mule Lisp directory of the XEmacs hierarchy. +ROOTS is a list of installation roots." ;; #### kludge (if lisp-directory (let ((guess @@ -215,7 +183,8 @@ configure-mule-lisp-directory))))) (defun paths-find-module-directory (roots) - "Find the main modules directory of the XEmacs hierarchy." + "Find the main modules directory of the XEmacs hierarchy. +ROOTS is a list of installation roots." (paths-find-architecture-directory roots "modules" nil configure-module-directory)) @@ -223,7 +192,14 @@ (roots early-package-load-path late-package-load-path last-package-load-path lisp-directory &optional site-lisp-directory mule-lisp-directory) - "Construct the load path." + "Construct the complete load path. +ROOTS is the list of installation roots. +EARLY-PACKAGE-LOAD-PATH, LATE-PACKAGE-LOAD-PATH, and LAST-PACKAGE-LOAD-PATH +are the load paths for the package hierarchies. +SITE-LISP-DIRECTORY and MULE-LISP-DIRECTORY are optional directories to be +included in the load path---SITE-LISP-DIRECTORY for the obsolete site-specific +Lisp files, and MULE-LISP-DIRECTORY for the Mule Lisp files, which exist +only in Mule installations." (let* ((envvar-value (getenv "EMACSLOADPATH")) (env-load-path (and envvar-value @@ -263,12 +239,19 @@ (and module-directory (paths-find-recursive-load-path (list module-directory) paths-core-load-path-depth)))) - (append env-module-path + (append env-module-path site-module-load-path module-load-path))) -(defun paths-construct-info-path (roots early-packages late-packages last-packages) - "Construct the info path." +(defun paths-construct-info-path (roots + early-package-hierarchies + late-package-hierarchies + last-package-hierarchies) + "Construct the info path. +ROOTS is the list of installation roots. +EARLY-PACKAGE-HIERARCHIES, LATE-PACKAGE-HIERARCHIES, and +LAST-PACKAGE-HIERARCHIES are lists of package hierarchy roots, +respectively." (let ((info-path-envval (getenv "INFOPATH"))) (paths-uniq-append (append @@ -278,9 +261,9 @@ configure-info-directory))) (and info-directory (list info-directory))) - (packages-find-package-info-path early-packages) - (packages-find-package-info-path late-packages) - (packages-find-package-info-path last-packages) + (packages-find-package-info-path early-package-hierarchies) + (packages-find-package-info-path late-package-hierarchies) + (packages-find-package-info-path last-package-hierarchies) (and info-path-envval (paths-decode-directory-path info-path-envval 'drop-empties))) (and (null info-path-envval) @@ -289,259 +272,60 @@ (paths-directories-which-exist paths-default-info-directories)))))) (defun paths-find-doc-directory (roots) - "Find the documentation directory." + "Find the documentation directory. +ROOTS is the list of installation roots." (paths-find-architecture-directory roots "lib-src" nil configure-doc-directory)) (defun paths-find-exec-directory (roots) - "Find the binary directory." + "Find the binary directory. +ROOTS is the list of installation roots." (paths-find-architecture-directory roots "lib-src" nil configure-exec-directory)) (defun paths-construct-exec-path (roots exec-directory - early-packages late-packages last-packages) - "Find the binary path." + early-package-hierarchies + late-package-hierarchies + last-package-hierarchies) + "Find the binary path. +ROOTS is the list of installation roots. +EARLY-PACKAGE-HIERARCHIES, LATE-PACKAGE-HIERARCHIES, and +LAST-PACKAGE-HIERARCHIES are lists of package hierarchy roots, +respectively. +EXEC-DIRECTORY is the directory of architecture-dependent files that +come with XEmacs. +EARLY-PACKAGES, LATE-PACKAGES, and LAST-PACKAGES are lists of +package hierarchy roots, respectively." (append (let ((path-envval (getenv "PATH"))) (if path-envval (paths-decode-directory-path path-envval 'drop-empties))) - (packages-find-package-exec-path early-packages) - (packages-find-package-exec-path late-packages) + (packages-find-package-exec-path early-package-hierarchies) + (packages-find-package-exec-path late-package-hierarchies) (let ((emacspath-envval (getenv "EMACSPATH"))) (and emacspath-envval (split-path emacspath-envval))) (and exec-directory (list exec-directory)) - (packages-find-package-exec-path last-packages))) + (packages-find-package-exec-path last-package-hierarchies))) (defun paths-find-data-directory (roots) - "Find the data directory." + "Find the data directory. +ROOTS is the list of installation roots." (paths-find-version-directory roots "etc" "EMACSDATA" configure-data-directory)) (defun paths-construct-data-directory-list (data-directory - early-packages late-packages last-packages) - "Find the data path." + early-package-hierarchies + late-package-hierarchies + last-package-hierarchies) + "Construct the data path. +DATA-DIRECTORY is the data directory of the XEmacs installation. +EARLY-PACKAGE-HIERARCHIES, LATE-PACKAGE-HIERARCHIES, and +LAST-PACKAGE-HIERARCHIES are lists of package hierarchy roots, +respectively." (append - (packages-find-package-data-path early-packages) - (packages-find-package-data-path late-packages) + (packages-find-package-data-path early-package-hierarchies) + (packages-find-package-data-path late-package-hierarchies) (list data-directory) - (packages-find-package-data-path last-packages))) - - -;;; High-level functions to set up the paths. - -(defun startup-find-load-path (&optional inhibit-packages - set-global-package-paths) - "Determine the value for `load-path'. -INHIBIT-PACKAGES says which types of packages, if any, to omit from the -returned value. It can be `t' (omit all), one of the symbols `early', -`late', or `last', or a list of one or more of the symbols. - -If SET-GLOBAL-PACKAGE-PATHS is non-nil, initialize the global package path -variables referring to the particular types of packages (`early-packages', -`early-package-load-path', `late-packages', `late-package-load-path', -`last-packages', `last-package-load-path')." - (let (earlyp latep lastp earlyp-lp latep-lp lastp-lp) - (apply #'(lambda (early late last) - (setq earlyp (and (not (memq 'early inhibit-packages)) early)) - (setq latep (and (not (memq 'late inhibit-packages)) late)) - (setq lastp (and (not (memq 'last inhibit-packages)) last))) - (packages-find-packages - emacs-data-roots - (packages-compute-package-locations user-init-directory))) - - (setq earlyp-lp (packages-find-package-load-path earlyp)) - (setq latep-lp (packages-find-package-load-path latep)) - (setq lastp-lp (packages-find-package-load-path lastp)) - - (when set-global-package-paths - (setq early-packages earlyp - late-packages latep - last-packages lastp - early-package-load-path earlyp-lp - late-package-load-path latep-lp - last-package-load-path lastp-lp)) - - (paths-construct-load-path emacs-roots earlyp-lp latep-lp lastp-lp - lisp-directory site-directory - mule-lisp-directory))) - -(defun startup-setup-paths (&optional inhibit-packages called-early) - "Setup all the various paths. -INHIBIT-PACKAGES says which types of packages, if any, to omit from the -returned value. It can be `t' (omit all), one of the symbols `early', -`late', or `last', or a list of one or more of the symbols. - -This function is idempotent, so call this as often as you like!" - - (setq debug-paths (or debug-paths - (and (getenv "EMACSDEBUGPATHS") - t))) - - (setq emacs-roots (paths-find-emacs-roots #'paths-emacs-data-root-p)) - - (setq emacs-data-roots (paths-find-emacs-roots #'paths-emacs-data-root-p)) - - (if (null emacs-roots) - (save-excursion - (set-buffer (get-buffer-create " *warning-tmp*")) - (erase-buffer) - (buffer-disable-undo (current-buffer)) - - (insert "Couldn't find an obvious default for the root of the\n" - "XEmacs hierarchy.") - - (princ "\nWARNING:\n" 'external-debugging-output) - (princ (buffer-string) 'external-debugging-output))) - - (if (eq inhibit-packages t) - (setq inhibit-packages '(early late last))) - (if (not (listp inhibit-packages)) - (setq inhibit-packages (list inhibit-packages))) - - (when debug-paths - (princ (format -"startup-setup-paths arguments: - inhibit-packages: %S - inhibit-site-lisp: %S - called-early: %S -" inhibit-packages inhibit-site-lisp called-early) - 'external-debugging-output) - (princ (format -"emacs-roots: -%S -emacs-data-roots: -%S -user-init-directory: %S -configure-package-path: %S -" emacs-roots emacs-data-roots user-init-directory configure-package-path) - 'external-debugging-output) - ) - - (setq lisp-directory (paths-find-lisp-directory emacs-roots)) - - (if debug-paths - (princ (format "lisp-directory:\n%S\n" lisp-directory) - 'external-debugging-output)) - - (if (featurep 'mule) - (progn - (setq mule-lisp-directory - (paths-find-mule-lisp-directory emacs-roots - lisp-directory)) - (if debug-paths - (princ (format "mule-lisp-directory:\n%S\n" - mule-lisp-directory) - 'external-debugging-output))) - (setq mule-lisp-directory '())) - - (setq site-directory (and (null inhibit-site-lisp) - (paths-find-site-lisp-directory emacs-roots))) - - (if (and debug-paths (null inhibit-site-lisp)) - (princ (format "site-directory:\n%S\n" site-directory) - 'external-debugging-output)) - - (setq load-path (startup-find-load-path inhibit-packages t)) - - (when debug-paths - (princ (format "early-packages and early-package-load-path:\n%S\n%S\n" - early-packages early-package-load-path) - 'external-debugging-output) - (princ (format "late-packages and late-package-load-path:\n%S\n%S\n" - late-packages late-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)) - - (if debug-paths - (princ (format "load-path:\n%S\n" load-path) - 'external-debugging-output)) - (setq module-directory (paths-find-module-directory emacs-roots)) - (if debug-paths - (princ (format "module-directory:\n%S\n" module-directory) - 'external-debugging-output)) - (setq site-module-directory (and (null inhibit-site-modules) - (paths-find-site-module-directory - emacs-roots))) - (if (and debug-paths (null inhibit-site-modules)) - (princ (format "site-module-directory:\n%S\n" - site-module-directory) - 'external-debugging-output)) - - (setq module-load-path (paths-construct-module-load-path - emacs-roots - module-directory - site-module-directory)) - - (unless called-early - (setq Info-directory-list - (paths-construct-info-path - emacs-roots early-packages late-packages last-packages)) - - (if debug-paths - (princ (format "Info-directory-list:\n%S\n" Info-directory-list) - 'external-debugging-output)) - - (setq exec-directory (paths-find-exec-directory emacs-roots)) - - (if debug-paths - (princ (format "exec-directory:\n%s\n" exec-directory) - 'external-debugging-output)) - - (setq exec-path - (paths-construct-exec-path emacs-roots exec-directory - early-packages late-packages - last-packages)) - - (if debug-paths - (princ (format "exec-path:\n%S\n" exec-path) - 'external-debugging-output)) - - (setq doc-directory (paths-find-doc-directory emacs-roots)) - - (if debug-paths - (princ (format "doc-directory:\n%S\n" doc-directory) - 'external-debugging-output)) - - (setq data-directory (paths-find-data-directory emacs-roots)) - - (if debug-paths - (princ (format "data-directory:\n%S\n" data-directory) - 'external-debugging-output)) - - (setq data-directory-list (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)))) - -(defun startup-find-load-path-for-packages (packages) - "Return a suitable load-path for PACKAGES. -PACKAGES is a list of package names (strings). This looks for package -directories in the load path whose last component is one of the members of -PACKAGES." - (mapcan - #'(lambda (package) - (and (member (file-name-nondirectory (directory-file-name package)) - packages) - (list package))) - (startup-find-load-path))) - -; (defun startup-set-basic-packages-load-path () -; "#### This is a hack. When recompiling .el files, we use -no-packages -; to avoid problems with packages shadowing standard Lisp files -; (e.g. unicode.el), but we really still need the stuff in xemacs-base and -; xemacs-devel, which SHOULD NOT be in the packages." -; (setq load-path (startup-find-load-path-for-packages -; '("xemacs-base" "xemacs-devel")))) - - -;;; Now actually set the paths up, for bootstrapping purposes. This is run -;;; at early dump time and in certain cases where we use a minimal temacs -;;; to do useful things, like rebuild DOC. - -(startup-setup-paths (if inhibit-all-packages t '(early last)) t) + (packages-find-package-data-path last-package-hierarchies))) ;;; setup-paths.el ends here
--- a/lisp/startup.el Sun Dec 26 22:52:34 2004 +0000 +++ b/lisp/startup.el Mon Dec 27 12:27:05 2004 +0000 @@ -129,7 +129,52 @@ (defconst initial-major-mode 'lisp-interaction-mode "Major mode command symbol to use for the initial *scratch* buffer.") + +;;; Path-related variables. +;;; NOTE: Many of them (`lisp-directory', `data-directory', etc.) are +;;; built-in. +(defvar emacs-roots nil + "List of plausible roots of the XEmacs hierarchy. +This is a list of plausible directories in which to search for the important +directories used by XEmacs at run-time, for example `exec-directory', +`data-directory' and `lisp-directory'. + +Normally set at startup by calling `paths-find-emacs-roots'.") + +(defvar emacs-data-roots nil + "List of plausible data roots of the XEmacs hierarchy.") + +(defvar user-init-directory-base ".xemacs" + "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))) + "Directory where user-installed init files may go.") + +(defvar user-init-file-base "init.el" + "Default name of the user init file if uncompiled. +This should be used for migration purposes only.") + +(defvar user-init-file-base-list '("init.el") + "List of allowed init files in the user's init directory. +The first one found takes precedence. .elc files do not need to be listed.") + +(defvar user-home-init-file-base-list + (append '(".emacs.el" ".emacs") + (and (eq system-type 'windows-nt) + '("_emacs.el" "_emacs"))) + "List of allowed init files in the user's home directory. +The first one found takes precedence. .elc files do not need to be listed.") + +(defvar load-home-init-file nil + "Non-nil if XEmacs should load the init file from the home directory. +Otherwise, XEmacs will offer migration to the init directory.") + +(defvar load-user-init-file-p t + "Non-nil if XEmacs should load the user's init file.") + ;; #### called `site-run-file' in FSFmacs (defvar site-start-file "site-start" @@ -1347,6 +1392,219 @@ ;; don't let /tmp_mnt/... get into the load-path or exec-path. (abbreviate-file-name invocation-directory))) +;;; High-level functions to set up the paths. + +(defun startup-find-load-path (&optional inhibit-packages + set-global-package-paths) + "Determine the value for `load-path'. +INHIBIT-PACKAGES says which types of packages, if any, to omit from the +returned value. It can be `t' (omit all), one of the symbols `early', +`late', or `last', or a list of one or more of the symbols. + +If SET-GLOBAL-PACKAGE-PATHS is non-nil, initialize the global package path +variables referring to the particular types of packages +(`early-package-hierarchies', `early-package-load-path', +`late-package-hierarchies', `late-package-load-path', +`last-package-hierarchies', `last-package-load-path')." + (let (earlyp latep lastp earlyp-lp latep-lp lastp-lp) + (apply #'(lambda (early late last) + (setq earlyp (and (not (memq 'early inhibit-packages)) early)) + (setq latep (and (not (memq 'late inhibit-packages)) late)) + (setq lastp (and (not (memq 'last inhibit-packages)) last))) + (packages-find-all-package-hierarchies + emacs-data-roots)) + + (setq earlyp-lp (packages-find-package-load-path earlyp)) + (setq latep-lp (packages-find-package-load-path latep)) + (setq lastp-lp (packages-find-package-load-path lastp)) + + (when set-global-package-paths + (setq early-package-hierarchies earlyp + late-package-hierarchies latep + last-package-hierarchies lastp + early-package-load-path earlyp-lp + late-package-load-path latep-lp + last-package-load-path lastp-lp)) + + (paths-construct-load-path emacs-roots earlyp-lp latep-lp lastp-lp + lisp-directory site-directory + mule-lisp-directory))) + +(defun startup-setup-paths (&optional inhibit-packages called-early) + "Setup all the various paths. +INHIBIT-PACKAGES says which types of packages, if any, to omit from the +returned value. It can be `t' (omit all), one of the symbols `early', +`late', or `last', or a list of one or more of the symbols. + +This function is idempotent, so call this as often as you like!" + + (setq debug-paths (or debug-paths + (and (getenv "EMACSDEBUGPATHS") + t))) + + (setq emacs-roots (paths-find-emacs-roots invocation-directory invocation-name + #'paths-emacs-data-root-p)) + + (setq emacs-data-roots (paths-find-emacs-roots invocation-directory invocation-name + #'paths-emacs-data-root-p)) + + (if (null emacs-roots) + (save-excursion + (set-buffer (get-buffer-create " *warning-tmp*")) + (erase-buffer) + (buffer-disable-undo (current-buffer)) + + (insert "Couldn't find an obvious default for the root of the\n" + "XEmacs hierarchy.") + + (princ "\nWARNING:\n" 'external-debugging-output) + (princ (buffer-string) 'external-debugging-output))) + + (if (eq inhibit-packages t) + (setq inhibit-packages '(early late last))) + (if (not (listp inhibit-packages)) + (setq inhibit-packages (list inhibit-packages))) + + (when debug-paths + (princ (format +"startup-setup-paths arguments: + inhibit-packages: %S + inhibit-site-lisp: %S + called-early: %S +" inhibit-packages inhibit-site-lisp called-early) + 'external-debugging-output) + (princ (format +"emacs-roots: +%S +emacs-data-roots: +%S +user-init-directory: %S +configure-package-path: %S +" emacs-roots emacs-data-roots user-init-directory configure-package-path) + 'external-debugging-output) + ) + + (setq lisp-directory (paths-find-lisp-directory emacs-roots)) + + (if debug-paths + (princ (format "lisp-directory:\n%S\n" lisp-directory) + 'external-debugging-output)) + + (if (featurep 'mule) + (progn + (setq mule-lisp-directory + (paths-find-mule-lisp-directory emacs-roots + lisp-directory)) + (if debug-paths + (princ (format "mule-lisp-directory:\n%S\n" + mule-lisp-directory) + 'external-debugging-output))) + (setq mule-lisp-directory '())) + + (setq site-directory (and (null inhibit-site-lisp) + (paths-find-site-lisp-directory emacs-roots))) + + (if (and debug-paths (null inhibit-site-lisp)) + (princ (format "site-directory:\n%S\n" site-directory) + 'external-debugging-output)) + + (setq load-path (startup-find-load-path inhibit-packages t)) + + (when debug-paths + (princ (format "early-package-hierarchies and early-package-load-path:\n%S\n%S\n" + early-package-hierarchies early-package-load-path) + 'external-debugging-output) + (princ (format "late-package-hierarchies and late-package-load-path:\n%S\n%S\n" + late-package-hierarchies late-package-load-path) + 'external-debugging-output) + (princ (format "last-package-hierarchies and last-package-load-path:\n%S\n%S\n" + last-package-hierarchies last-package-load-path) + 'external-debugging-output)) + + (if debug-paths + (princ (format "load-path:\n%S\n" load-path) + 'external-debugging-output)) + (setq module-directory (paths-find-module-directory emacs-roots)) + (if debug-paths + (princ (format "module-directory:\n%S\n" module-directory) + 'external-debugging-output)) + (setq site-module-directory (and (null inhibit-site-modules) + (paths-find-site-module-directory + emacs-roots))) + (if (and debug-paths (null inhibit-site-modules)) + (princ (format "site-module-directory:\n%S\n" + site-module-directory) + 'external-debugging-output)) + + (setq module-load-path (paths-construct-module-load-path + emacs-roots + module-directory + site-module-directory)) + + (unless called-early + (setq Info-directory-list + (paths-construct-info-path + emacs-roots + early-package-hierarchies late-package-hierarchies last-package-hierarchies)) + + (if debug-paths + (princ (format "Info-directory-list:\n%S\n" Info-directory-list) + 'external-debugging-output)) + + (setq exec-directory (paths-find-exec-directory emacs-roots)) + + (if debug-paths + (princ (format "exec-directory:\n%s\n" exec-directory) + 'external-debugging-output)) + + (setq exec-path + (paths-construct-exec-path emacs-roots exec-directory + early-package-hierarchies late-package-hierarchies + last-package-hierarchies)) + + (if debug-paths + (princ (format "exec-path:\n%S\n" exec-path) + 'external-debugging-output)) + + (setq doc-directory (paths-find-doc-directory emacs-roots)) + + (if debug-paths + (princ (format "doc-directory:\n%S\n" doc-directory) + 'external-debugging-output)) + + (setq data-directory (paths-find-data-directory emacs-roots)) + + (if debug-paths + (princ (format "data-directory:\n%S\n" data-directory) + 'external-debugging-output)) + + (setq data-directory-list (paths-construct-data-directory-list + data-directory early-package-hierarchies + late-package-hierarchies last-package-hierarchies)) + (if debug-paths + (princ (format "data-directory-list:\n%S\n" data-directory-list) + 'external-debugging-output)))) + +(defun startup-find-load-path-for-packages (packages) + "Return a suitable load-path for PACKAGES. +PACKAGES is a list of package names (strings). This looks for package +directories in the load path whose last component is one of the members of +PACKAGES." + (mapcan + #'(lambda (package) + (and (member (file-name-nondirectory (directory-file-name package)) + packages) + (list package))) + (startup-find-load-path))) + +; (defun startup-set-basic-packages-load-path () +; "#### This is a hack. When recompiling .el files, we use -no-packages +; to avoid problems with packages shadowing standard Lisp files +; (e.g. unicode.el), but we really still need the stuff in xemacs-base and +; xemacs-devel." +; (setq load-path (startup-find-load-path-for-packages +; '("xemacs-base" "xemacs-devel")))) + (defun startup-setup-paths-warning () (let ((warnings '())) (cond @@ -1379,6 +1637,14 @@ (erase-buffer) t))))) + +;;; Now actually set the paths up, for bootstrapping purposes. This is run +;;; at early dump time and in certain cases where we use a minimal temacs +;;; to do useful things, like rebuild DOC. + +(startup-setup-paths (if inhibit-all-packages t '(early last)) t) + + (defun startup-load-autoloads () (when (and (not inhibit-autoloads) lisp-directory) (load (expand-file-name (file-name-sans-extension autoload-file-name)
--- a/lisp/update-elc.el Sun Dec 26 22:52:34 2004 +0000 +++ b/lisp/update-elc.el Mon Dec 27 12:27:05 2004 +0000 @@ -210,7 +210,7 @@ (print (format "Error: Library file %s not found" arg)) (backtrace) ;; Uncomment in case of trouble - ;;(print (format "late-packages: %S" late-packages)) + ;;(print (format "late-package-hierarchies: %S" late-package-hierarchies)) ;;(print (format "guessed-roots: %S" ;; (paths-find-emacs-roots ;; invocation-directory invocation-name)))