Mercurial > hg > xemacs-beta

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b35
author cvs
date Mon, 13 Aug 2007 10:29:42 +0200
parents c5d627a313b1
children 6330739388db
comparison
equal deleted inserted replaced
273:411aac7253ef 274:ca9a9ec9c1c1
79 (and 79 (and
80 (file-directory-p (concat directory "lib-src")) 80 (file-directory-p (concat directory "lib-src"))
81 (file-directory-p (concat directory "lisp")) 81 (file-directory-p (concat directory "lisp"))
82 (file-directory-p (concat directory "src"))))) 82 (file-directory-p (concat directory "src")))))
83 83
84 (defun paths-chase-symlink (file-name)
85 "Chase a symlink until the bitter end."
86 (let ((maybe-symlink (file-symlink-p file-name)))
87 (if maybe-symlink
88 (let* ((directory (file-name-directory file-name))
89 (destination (expand-file-name maybe-symlink directory)))
90 (paths-chase-symlink destination))
91 file-name)))
92
84 (defun paths-find-emacs-root 93 (defun paths-find-emacs-root
85 (invocation-directory invocation-name) 94 (invocation-directory invocation-name)
86 "Find the run-time root of XEmacs." 95 "Find the run-time root of XEmacs."
87 (let ((maybe-root-1 (file-name-as-directory 96 (let* ((executable-file-name (paths-chase-symlink
88 (expand-file-name ".." invocation-directory))) 97 (concat invocation-directory
89 (maybe-root-2 (file-name-as-directory 98 invocation-name)))
90 (expand-file-name "../.." invocation-directory)))) 99 (executable-directory (file-name-directory executable-file-name))
91 (cond 100 (maybe-root-1 (file-name-as-directory
92 ((paths-emacs-root-p maybe-root-1) 101 (expand-file-name ".." executable-directory)))
93 maybe-root-1) 102 (maybe-root-2 (file-name-as-directory
94 ((paths-emacs-root-p maybe-root-2) 103 (expand-file-name "../.." executable-directory))))
95 maybe-root-2) 104 (or (and (paths-emacs-root-p maybe-root-1)
96 (t 105 maybe-root-1)
97 (let ((maybe-symlink (file-symlink-p (concat invocation-directory 106 (and (paths-emacs-root-p maybe-root-2)
98 invocation-name)))) 107 maybe-root-2))))
99 (if maybe-symlink
100 (let* ((symlink (expand-file-name maybe-symlink invocation-directory))
101 (directory (file-name-directory symlink)))
102 (paths-find-emacs-root directory invocation-name))
103 nil))))))
104 108
105 (defun paths-construct-emacs-directory (root suffix base) 109 (defun paths-construct-emacs-directory (root suffix base)
106 "Construct a directory name within the XEmacs hierarchy." 110 "Construct a directory name within the XEmacs hierarchy."
107 (file-name-as-directory 111 (file-name-as-directory
108 (expand-file-name 112 (expand-file-name
211 (cons (car directories) 215 (cons (car directories)
212 reverse-directories))) 216 reverse-directories)))
213 (setq directories (cdr directories))) 217 (setq directories (cdr directories)))
214 (reverse reverse-directories))) 218 (reverse reverse-directories)))
215 219
220 (defun paths-uniq-append (list-1 list-2)
221 "Append LIST-1 and LIST-2, omitting duplicates."
222 (let ((reverse-survivors '()))
223 (while list-2
224 (if (null (member (car list-2) list-1))
225 (setq reverse-survivors (cons (car list-2) reverse-survivors)))
226 (setq list-2 (cdr list-2)))
227 (append list-1
228 (reverse reverse-survivors))))
229
216 (defun paths-find-site-path (roots base &optional envvar default) 230 (defun paths-find-site-path (roots base &optional envvar default)
217 "Find a path underneath the site hierarchy." 231 "Find a path underneath the site hierarchy."
218 (paths-find-emacs-path roots "lib/xemacs/" base envvar default)) 232 (paths-find-emacs-path roots "lib/xemacs/" base envvar default))
219 233
220 (defun paths-find-version-path (roots base &optional envvar default) 234 (defun paths-find-version-path (roots base &optional envvar default)