diff lisp/find-paths.el @ 274:ca9a9ec9c1c1 r21-0b35

Import from CVS: tag r21-0b35
author cvs
date Mon, 13 Aug 2007 10:29:42 +0200
parents c5d627a313b1
children 6330739388db
line wrap: on
line diff
--- a/lisp/find-paths.el	Mon Aug 13 10:28:54 2007 +0200
+++ b/lisp/find-paths.el	Mon Aug 13 10:29:42 2007 +0200
@@ -81,26 +81,30 @@
     (file-directory-p (concat directory "lisp"))
     (file-directory-p (concat directory "src")))))
 
+(defun paths-chase-symlink (file-name)
+  "Chase a symlink until the bitter end."
+      (let ((maybe-symlink (file-symlink-p file-name)))
+	(if maybe-symlink
+	    (let* ((directory (file-name-directory file-name))
+		   (destination (expand-file-name maybe-symlink directory)))
+	      (paths-chase-symlink destination))
+	  file-name)))
+
 (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* ((symlink (expand-file-name maybe-symlink invocation-directory))
-		   (directory (file-name-directory symlink)))
-	      (paths-find-emacs-root directory invocation-name))
-	  nil))))))
+  (let* ((executable-file-name (paths-chase-symlink
+				(concat invocation-directory
+					invocation-name)))
+	 (executable-directory (file-name-directory executable-file-name))
+	 (maybe-root-1 (file-name-as-directory
+			(expand-file-name ".." executable-directory)))
+	 (maybe-root-2 (file-name-as-directory
+			(expand-file-name "../.." executable-directory))))
+    (or (and (paths-emacs-root-p maybe-root-1)
+	     maybe-root-1)
+	(and (paths-emacs-root-p maybe-root-2)
+	     maybe-root-2))))
 
 (defun paths-construct-emacs-directory (root suffix base)
   "Construct a directory name within the XEmacs hierarchy."
@@ -213,6 +217,16 @@
       (setq directories (cdr directories)))
     (reverse reverse-directories)))
 
+(defun paths-uniq-append (list-1 list-2)
+  "Append LIST-1 and LIST-2, omitting duplicates."
+  (let ((reverse-survivors '()))
+    (while list-2
+      (if (null (member (car list-2) list-1))
+	  (setq reverse-survivors (cons (car list-2) reverse-survivors)))
+      (setq list-2 (cdr list-2)))
+    (append list-1
+	    (reverse reverse-survivors))))
+
 (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))