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))