Mercurial > hg > xemacs-beta
changeset 1227:5636ae1c0234
[xemacs-hg @ 2003-01-22 20:31:52 by michaels]
2003-01-19 Mike Sperber <mike@xemacs.org>
* startup.el (normal-top-level): Compute `emacs-data-roots.' Call
`startup-setup-paths' with data-roots argument.
(emacs-data-roots): Add.
* dump-paths.el: Call `startup-setup-paths' with
data-roots argument.
(startup-setup-paths): Use `data-roots' instead of `roots' to find
packages.
Call `paths-find-emacs-roots' with `root-p' argument.
* make-docfile.el: Call `paths-find-emacs-roots' with `root-p' argument.
* find-paths.el (paths-emacs-data-root-p): Add.
(paths-find-emacs-roots): Parmeterize over `root-p.'
author | michaels |
---|---|
date | Wed, 22 Jan 2003 20:31:52 +0000 |
parents | 440b3dcb60ed |
children | f70e074d0ca9 |
files | lisp/ChangeLog lisp/dump-paths.el lisp/find-paths.el lisp/loadup.el lisp/make-docfile.el lisp/startup.el |
diffstat | 6 files changed, 74 insertions(+), 19 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Tue Jan 21 22:52:39 2003 +0000 +++ b/lisp/ChangeLog Wed Jan 22 20:31:52 2003 +0000 @@ -1,3 +1,20 @@ +2003-01-19 Mike Sperber <mike@xemacs.org> + + * startup.el (normal-top-level): Compute `emacs-data-roots.' Call + `startup-setup-paths' with data-roots argument. + (emacs-data-roots): Add. + + * dump-paths.el: Call `startup-setup-paths' with + data-roots argument. + (startup-setup-paths): Use `data-roots' instead of `roots' to find + packages. + Call `paths-find-emacs-roots' with `root-p' argument. + + * make-docfile.el: Call `paths-find-emacs-roots' with `root-p' argument. + + * find-paths.el (paths-emacs-data-root-p): Add. + (paths-find-emacs-roots): Parmeterize over `root-p.' + 2003-01-13 Ilya Golubev <golubev@xemacs.org> * about.el: Update golubev data.
--- a/lisp/dump-paths.el Tue Jan 21 22:52:39 2003 +0000 +++ b/lisp/dump-paths.el Wed Jan 22 20:31:52 2003 +0000 @@ -31,7 +31,7 @@ ;; This is the only file of the basic path/package files (find-paths.el, ;; package.el, setup-paths.el, dump-paths.el) that actually does stuff. -(defun startup-setup-paths (roots user-init-directory +(defun startup-setup-paths (roots data-roots user-init-directory &optional inhibit-packages inhibit-site-lisp debug-paths called-early) @@ -56,18 +56,17 @@ last)) ) (packages-find-packages - roots + data-roots (packages-compute-package-locations user-init-directory))) - (setq early-package-load-path (packages-find-package-load-path - early-packages)) + (setq early-package-load-path (packages-find-package-load-path early-packages)) (setq late-package-load-path (packages-find-package-load-path late-packages)) (setq last-package-load-path (packages-find-package-load-path last-packages)) (if debug-paths (progn - (princ (format "arguments:\nroots: %S\nuser-init-directory: %S\n" - roots user-init-directory) + (princ (format "arguments:\nroots: %S\ndata-roots: %S\nuser-init-directory: %S\n" + roots data-roots user-init-directory) 'external-debugging-output) (princ (format "inhibit-packages: %S\ninhibit-site-lisp: %S\n" inhibit-packages inhibit-site-lisp) @@ -185,13 +184,21 @@ (and (getenv "EMACSDEBUGPATHS") t))) (roots (paths-find-emacs-roots invocation-directory - invocation-name))) + invocation-name + #'paths-emacs-root-p)) + (data-roots (paths-find-emacs-roots invocation-directory + invocation-name + #'paths-emacs-data-root-p))) (if debug-paths - (princ (format "XEmacs thinks the roots of its hierarchy are:\n%S\n" - roots) - 'external-debugging-output)) - (startup-setup-paths roots + (progn + (princ (format "XEmacs thinks the roots of its hierarchy are:\n%S\n" + roots) + 'external-debugging-output) + (princ (format "XEmacs thinks the data roots of its hierarchy are:\n%S\n" + data-roots) + 'external-debugging-output))) + (startup-setup-paths roots data-roots (paths-construct-path '("~" ".xemacs")) (if inhibit-all-packages t '(early last))
--- a/lisp/find-paths.el Tue Jan 21 22:52:39 2003 +0000 +++ b/lisp/find-paths.el Wed Jan 22 20:31:52 2003 +0000 @@ -100,7 +100,7 @@ max-depth paths-no-lisp-directory-regexp)) (defun paths-emacs-root-p (directory) - "Check if DIRECTORY is a plausible installation root for XEmacs." + "Check if DIRECTORY is a plausible installation root." (or ;; installed (paths-file-readable-directory-p (paths-construct-path (list directory @@ -111,6 +111,23 @@ (paths-file-readable-directory-p (paths-construct-path (list directory "lisp"))) (paths-file-readable-directory-p (paths-construct-path (list directory "etc")))))) +(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." + (or + ;; installed + (paths-file-readable-directory-p (paths-construct-path (list directory + "lib" + emacs-program-name))) + (paths-file-readable-directory-p (paths-construct-path (list directory + "lib" + (construct-emacs-version-name)))) + ;; in-place or windows-nt + (and + (paths-file-readable-directory-p (paths-construct-path (list directory "lisp"))) + (paths-file-readable-directory-p (paths-construct-path (list directory "etc")))))) + (defun paths-chase-symlink (file-name) "Chase a symlink until the bitter end." (let ((maybe-symlink (file-symlink-p file-name))) @@ -282,8 +299,13 @@ directories))) (defun paths-find-emacs-roots (invocation-directory - invocation-name) - "Find all plausible installation roots for XEmacs." + invocation-name + root-p) + "Find all plausible installation roots for XEmacs. +INVOCATION-DIRECTORY is the directory from which XEmacs was started. +INVOCATION-NAME is the name of the XEmacs executable that was originally +started. +ROOT-P is a function that tests whether a root is plausible." (let* ((potential-invocation-root (paths-find-emacs-root invocation-directory invocation-name)) (invocation-roots @@ -298,7 +320,7 @@ (list (file-name-as-directory configure-prefix-directory))))) (installation-roots - (paths-filter #'paths-emacs-root-p potential-installation-roots))) + (paths-filter root-p potential-installation-roots))) (paths-uniq-append invocation-roots installation-roots)))
--- a/lisp/loadup.el Tue Jan 21 22:52:39 2003 +0000 +++ b/lisp/loadup.el Wed Jan 22 20:31:52 2003 +0000 @@ -124,7 +124,8 @@ file)) ;; Uncomment in case of trouble ;;(print (format "late-packages: %S" late-packages)) - ;;(print (format "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name))) + ;;(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))) (load (expand-file-name "../lisp/dumped-lisp.el"))
--- a/lisp/make-docfile.el Tue Jan 21 22:52:39 2003 +0000 +++ b/lisp/make-docfile.el Wed Jan 22 20:31:52 2003 +0000 @@ -112,7 +112,8 @@ (princ (format "Error: dumped file %s does not exist\n" arg0)) ;; Uncomment in case of difficulties ;;(print (format "late-packages: %S" late-packages)) - ;;(print (format "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name))) + ;;(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))) ) (if (null (member arg processed)) (progn
--- a/lisp/startup.el Tue Jan 21 22:52:39 2003 +0000 +++ b/lisp/startup.el Wed Jan 22 20:31:52 2003 +0000 @@ -133,6 +133,9 @@ (defvar emacs-roots nil "List of plausible roots of the XEmacs hierarchy.") +(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.") @@ -517,7 +520,11 @@ t)))) (setq emacs-roots (paths-find-emacs-roots invocation-directory - invocation-name)) + invocation-name + #'paths-emacs-root-p)) + (setq emacs-data-roots (paths-find-emacs-roots invocation-directory + invocation-name + #'paths-emacs-data-root-p)) (if debug-paths (princ (format "emacs-roots:\n%S\n" emacs-roots) @@ -525,7 +532,7 @@ (if (null emacs-roots) (startup-find-roots-warning)) - (startup-setup-paths emacs-roots + (startup-setup-paths emacs-roots emacs-data-roots user-init-directory (cond (inhibit-all-packages t) (inhibit-early-packages '(early))