X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Ffind-paths.el;h=fdd3cc2b5745c83de3926d46df4ec546476b02a2;hb=762383636a99307282c2d93d26c35c046ec24da1;hp=9118e94de3136eb4743dcc4d4b48c32f9500a6f8;hpb=e31bfd1501359ce20fe1caf6b913a019318ec83c;p=chise%2Fxemacs-chise.git- diff --git a/lisp/find-paths.el b/lisp/find-paths.el index 9118e94..fdd3cc2 100644 --- a/lisp/find-paths.el +++ b/lisp/find-paths.el @@ -109,6 +109,10 @@ from the search." (paths-file-readable-directory-p (paths-construct-path (list directory "lisp"))) (paths-file-readable-directory-p (paths-construct-path (list directory "etc")))))) +(defun paths-root-in-place-p (root) + "Check if ROOT is an in-place installation root for XEmacs." + (paths-file-readable-directory-p (paths-construct-path (list root "lisp")))) + (defun paths-chase-symlink (file-name) "Chase a symlink until the bitter end." (let ((maybe-symlink (file-symlink-p file-name))) @@ -159,7 +163,8 @@ to EXPAND-FILE-NAME." base)))) (defun paths-find-emacs-directory (roots suffix base - &optional envvar default keep-suffix) + &optional envvar default keep-suffix + in-place-external) "Find a directory in the XEmacs hierarchy. ROOTS must be a list of installation roots. SUFFIX is the subdirectory from there. @@ -168,7 +173,9 @@ ENVVAR is the name of the environment variable that might also specify the directory. DEFAULT is the preferred value. If KEEP-SUFFIX is non-nil, the suffix must be respected in searching -the directory." +the directory. +If IN-PLACE-EXTERNAL is non-nil, the directory might be found outside +an in-place root-hierarchy." (let ((preferred-value (or (and envvar (getenv envvar)) default))) (if (and preferred-value @@ -176,28 +183,39 @@ the directory." (file-name-as-directory preferred-value) (catch 'gotcha (while roots - (let* ((root (car roots)) - ;; installed - (path (paths-construct-emacs-directory root suffix base))) - (if (paths-file-readable-directory-p path) - (throw 'gotcha path) - ;; in-place - (if (null keep-suffix) - (let ((path (paths-construct-emacs-directory root "" base))) - (if (paths-file-readable-directory-p path) - (throw 'gotcha path)))))) + (let ((root (car roots))) + ;; installed + (let ((path (paths-construct-emacs-directory root suffix base))) + (if (paths-file-readable-directory-p path) + (throw 'gotcha path))) + ;; in-place + (if (null keep-suffix) + (let ((path (paths-construct-emacs-directory root "" base))) + (if (paths-file-readable-directory-p path) + (throw 'gotcha path)))) + (if (and in-place-external + (paths-root-in-place-p root)) + (let ((path (paths-construct-emacs-directory + (paths-construct-path '("..") root) + "" base))) + (if (paths-file-readable-directory-p path) + (throw 'gotcha path))))) (setq roots (cdr roots))) nil)))) -(defun paths-find-site-directory (roots base &optional envvar default) - "Find a site-specific directory in the XEmacs hierarchy." +(defun paths-find-site-directory (roots base &optional envvar default in-place-external) + "Find a site-specific directory in the XEmacs hierarchy. +If IN-PLACE-EXTERNAL is non-nil, the directory might be found outside +an in-place root-hierarchy." (paths-find-emacs-directory roots (file-name-as-directory (paths-construct-path (list "lib" emacs-program-name))) base - envvar default)) + envvar default + nil + in-place-external)) (defun paths-find-version-directory (roots base &optional envvar default enforce-version)