(U-000278B8): Apply new conventions for glyph granularity.
[chise/xemacs-chise.git.1] / lisp / find-paths.el
index f5be624..bad05a9 100644 (file)
@@ -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