X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Ffind-paths.el;h=bad05a92849ab0f48af1b6fc0b9399c53bd87d4c;hb=dff25f45a911f8a0e5c5bde4c1df0b01e7289fb4;hp=f5be62429e6f46a249e84b9c1d4a75f93a99cb91;hpb=a5f466de30a3e927ed1146b0c7e3870e71465c8f;p=chise%2Fxemacs-chise.git.1 diff --git a/lisp/find-paths.el b/lisp/find-paths.el index f5be624..bad05a9 100644 --- a/lisp/find-paths.el +++ b/lisp/find-paths.el @@ -69,7 +69,8 @@ from the search." (directory-files directory nil "^[^.-]"))) (reverse-dirs '())) (while raw-entries - (if (null (string-match exclude-regexp (car raw-entries))) + (if (not (and exclude-regexp + (string-match exclude-regexp (car raw-entries)))) (setq reverse-dirs (cons (expand-file-name (car raw-entries) directory) reverse-dirs))) @@ -107,7 +108,16 @@ from the search." ;; 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")))))) + (paths-file-readable-directory-p (paths-construct-path (list directory "etc")))) + + ;; searching for a package directory on Windows + (and + (string-match "win32\\|cygwin" system-configuration) + (paths-file-readable-directory-p (paths-construct-path (list directory "xemacs-packages")))))) + +(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." @@ -118,9 +128,10 @@ from the search." (paths-chase-symlink destination)) file-name))) -(defun paths-find-emacs-root - (invocation-directory invocation-name) - "Find the run-time root of XEmacs." +(defun paths-find-invocation-roots (invocation-directory invocation-name) + "Find the list of run-time roots of XEmacs. +INVOCATION-DIRECTORY is a directory containing the XEmacs executable. +INVOCATION-NAME is the name of the executable itself." (let* ((executable-file-name (paths-chase-symlink (concat invocation-directory invocation-name))) @@ -129,10 +140,9 @@ from the search." (paths-construct-path '("..") executable-directory))) (maybe-root-2 (file-name-as-directory (paths-construct-path '(".." "..") 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)))) + + (paths-filter #'paths-emacs-root-p + (list maybe-root-1 maybe-root-2)))) (defun paths-construct-path (components &optional expand-directory) "Convert list of path components COMPONENTS into a path. @@ -159,7 +169,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 +179,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 +189,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) @@ -217,14 +241,15 @@ If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version." (or ;; from more to less specific (paths-find-version-directory roots - (concat base system-configuration) - envvar) + (paths-construct-path + (list system-configuration base)) + envvar default) (paths-find-version-directory roots base envvar) (paths-find-version-directory roots system-configuration - envvar default))) + envvar))) (defun construct-emacs-version-name () "Construct the raw XEmacs version number." @@ -262,7 +287,7 @@ If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version." (defun paths-decode-directory-path (string &optional drop-empties) "Split STRING at path separators into a directory list. -Non-\"\" comonents are converted into directory form. +Non-\"\" components are converted into directory form. If DROP-EMPTIES is non-NIL, \"\" components are dropped from the output. Otherwise, they are left alone." (let* ((components (split-path string)) @@ -281,11 +306,8 @@ Otherwise, they are left alone." (defun paths-find-emacs-roots (invocation-directory invocation-name) "Find all plausible installation roots for XEmacs." - (let* ((potential-invocation-root - (paths-find-emacs-root invocation-directory invocation-name)) - (invocation-roots - (and potential-invocation-root - (list potential-invocation-root))) + (let* ((invocation-roots + (paths-find-invocation-roots invocation-directory invocation-name)) (potential-installation-roots (paths-uniq-append (and configure-exec-prefix-directory