--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/find-paths.el	Mon Aug 13 10:26:29 2007 +0200
@@ -0,0 +1,241 @@
+;;; find-paths.el --- setup various XEmacs paths
+
+;; Copyright (C) 1985-1986, 1990, 1992-1997 Free Software Foundation, Inc.
+;; Copyright (c) 1993, 1994 Sun Microsystems, Inc.
+;; Copyright (C) 1995 Board of Trustees, University of Illinois
+
+;; Author: Mike Sperber <sperber@informatik.uni-tuebingen.de>
+;; Maintainer: XEmacs Development Team
+;; Keywords: internal, dumped
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the 
+;; Free Software Foundation, 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Synched up with: Not in FSF.
+
+;;; Commentary:
+
+;; This file is dumped with XEmacs.
+
+;; This file contains the library functionality to find paths into the
+;; XEmacs hierarchy.
+
+;;; Code:
+
+(defvar paths-version-control-bases '("RCS" "CVS" "SCCS")
+  "File bases associated with version control.")
+
+(defun paths-find-recursive-path (directories &optional exclude)
+  "Return a list of the directory hierarchy underneath DIRECTORIES.
+The returned list is sorted by pre-order and lexicographically."
+  (let ((path '()))
+    (while directories
+      (let ((directory (file-name-as-directory
+			(expand-file-name
+			 (car directories)))))
+	(if (file-directory-p directory)
+	    (let ((raw-dirs (directory-files directory nil "^[^-.]" nil 'dirs-only))
+		  (reverse-dirs '()))
+
+	      (while raw-dirs
+		(if (null (member (car raw-dirs) exclude))
+		    (setq reverse-dirs
+			  (cons (expand-file-name (car raw-dirs) directory)
+				reverse-dirs)))
+		(setq raw-dirs (cdr raw-dirs)))
+
+	      (let ((sub-path
+		     (paths-find-recursive-path (reverse reverse-dirs) exclude)))
+		(setq path (nconc path
+				  (list directory)
+				  sub-path))))))
+      (setq directories (cdr directories)))
+    path))
+
+(defun paths-find-recursive-load-path (directories)
+  "Construct a recursive load path underneath DIRECTORIES."
+  (paths-find-recursive-path directories paths-version-control-bases))
+
+(defun paths-emacs-root-p (directory)
+  "Check if DIRECTORY is a plausible installation root for XEmacs."
+  (or
+   ;; installed
+   (file-directory-p
+    (concat directory "lib/xemacs-" (construct-emacs-version)))
+   ;; in-place
+   (and 
+    (file-directory-p (concat directory "lib-src"))
+    (file-directory-p (concat directory "lisp"))
+    (file-directory-p (concat directory "src")))))
+
+(defun paths-find-emacs-root
+  (invocation-directory invocation-name)
+  "Find the run-time root of XEmacs."
+  (let ((maybe-root-1 (file-name-as-directory
+		       (expand-file-name ".." invocation-directory)))
+	(maybe-root-2 (file-name-as-directory
+		       (expand-file-name "../.." invocation-directory))))
+    (cond
+     ((paths-emacs-root-p maybe-root-1)
+      maybe-root-1)
+     ((paths-emacs-root-p maybe-root-2)
+      maybe-root-2)
+     (t
+      (let ((maybe-symlink (file-symlink-p (concat invocation-directory
+						   invocation-name))))
+	(if maybe-symlink
+	    (let ((directory (file-name-directory maybe-symlink)))
+	      (paths-find-emacs-root directory invocation-name))
+	  nil))))))
+
+(defun paths-construct-emacs-directory (root suffix base)
+  "Construct a directory name within the XEmacs hierarchy."
+  (file-name-as-directory
+   (expand-file-name 
+    (concat
+     (file-name-as-directory root)
+     suffix
+     base))))
+
+(defun paths-find-emacs-directory (roots suffix base &optional envvar default)
+  "Find a directory in the XEmacs hierarchy.
+ROOTS must be a list of installation roots.
+SUFFIX is the subdirectory from there.
+BASE is the base to look for.
+ENVVAR is the name of the environment variable that might also
+specify the directory.
+DEFAULT is a fall-back value."
+  (let ((envvar-value (and envvar (getenv envvar))))
+    (if (and envvar-value
+	     (file-directory-p envvar-value))
+	(file-name-as-directory envvar-value)
+      (catch 'gotcha
+	(while roots
+	  (let* ((root (car roots))
+		 (path (paths-construct-emacs-directory root suffix base)))
+	    ;; installed
+	    (if (file-directory-p path)
+		(throw 'gotcha path)
+	      (let ((path (paths-construct-emacs-directory root "" base)))
+		;; in-place
+		(if (file-directory-p path)
+		    (throw 'gotcha path)))))
+	  (setq roots (cdr roots)))
+	(if (and default
+		 (file-directory-p default))
+	    (file-name-as-directory default)
+	  nil)))))
+
+(defun paths-find-site-directory (roots base &optional envvar default)
+  "Find a site-specific directory in the XEmacs hierarchy."
+  (paths-find-emacs-directory roots "lib/xemacs/" base envvar default))
+
+(defun paths-find-version-directory (roots base &optional envvar default)
+  "Find a version-specific directory in the XEmacs hierarchy."
+  (paths-find-emacs-directory roots
+			      (concat "lib/xemacs-" (construct-emacs-version) "/")
+			      base
+			      envvar default))
+
+(defun paths-find-architecture-directory (roots base &optional envvar default)
+  "Find an architecture-specific directory in the XEmacs hierarchy."
+  (or
+   ;; from more to less specific
+   (paths-find-version-directory roots
+				 (concat base system-configuration)
+				 envvar default)
+   (paths-find-version-directory roots
+				 system-configuration
+				 envvar default)
+   (paths-find-version-directory roots
+				 base
+				 envvar default)))
+  
+(defvar paths-path-emacs-version nil
+  "Emacs version as it appears in paths.")
+
+(defun construct-emacs-version ()
+  "Construct the raw version number of XEmacs in the form XX.XX."
+  ;; emacs-version isn't available early, but we really don't care then
+  (if (null (boundp 'emacs-version))
+      "XX.XX"
+  (or paths-path-emacs-version		; cache
+      (progn
+	(string-match "\\`[^0-9]*\\([0-9]+\\.[0-9]+\\)" emacs-version)
+	(let ((version (substring emacs-version
+				  (match-beginning 1) (match-end 1))))
+	  (if (string-match "(beta *\\([0-9]+\\))" emacs-version)
+	      (setq version (concat version
+				    "-b"
+				    (substring emacs-version
+					       (match-beginning 1) (match-end 1)))))
+	  (setq paths-path-emacs-version version)
+	  version)))))
+  
+(defun paths-find-emacs-path (roots suffix base &optional envvar default)
+  "Find a path in the XEmacs hierarchy.
+ROOTS must be a list of installation roots.
+SUFFIX is the subdirectory from there.
+BASE is the base to look for.
+ENVVAR is the name of the environment variable that might also
+specify the path.
+DEFAULT is a fall-back value."
+  (let ((envvar-value (and envvar (getenv envvar))))
+    (if envvar-value
+	(decode-path-internal envvar-value)
+      (let ((directory (paths-find-emacs-directory roots base suffix)))
+	(if (and directory (file-directory-p directory))
+	    (list directory)
+	  (paths-directories-which-exist default))))))
+
+(defun paths-directories-which-exist (directories)
+  "Return the directories among DIRECTORIES."
+  (let ((reverse-directories '()))
+    (while directories
+      (if (file-directory-p (car directories))
+	  (setq reverse-directories 
+		(cons (car directories)
+		      reverse-directories)))
+      (setq directories (cdr directories)))
+    (reverse reverse-directories)))
+
+(defun paths-find-site-path (roots base &optional envvar default)
+  "Find a path underneath the site hierarchy."
+  (paths-find-emacs-path roots "lib/xemacs/" base envvar default))
+
+(defun paths-find-version-path (roots base &optional envvar default)
+  "Find a path underneath the site hierarchy."
+  (paths-find-emacs-path roots
+			 (concat "lib/xemacs-" (construct-emacs-version) "/")
+			 base
+			 envvar default))
+		   
+(defun paths-find-emacs-roots (invocation-directory
+			       invocation-name)
+  "Find all plausible installation roots for XEmacs."
+  (let ((invocation-root
+	 (paths-find-emacs-root invocation-directory invocation-name))
+	(installation-root
+	 (if (and configure-prefix-directory
+		  (file-directory-p configure-prefix-directory))
+	     configure-prefix-directory)))
+    (append (and invocation-root
+		 (list invocation-root))
+	    (and installation-root
+		 (list installation-root)))))
+
+;;; find-paths.el ends here