From: Eli Zaretskii <eliz@gnu.org>
Date: Sat, 26 Nov 2022 10:59:06 +0000 (+0200)
Subject: Fix generation of autoloads on MS-Windows
X-Git-Tag: emacs-29.0.90~1487
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=4dec4aadf6e3c20aac0b19210e8ed9508cee9399;p=emacs.git

Fix generation of autoloads on MS-Windows

* lisp/emacs-lisp/loaddefs-gen.el
(loaddefs-generate--file-load-name): Handle the case when FILE and
OUTFILE don't share any common ancestor directory.  (Bug#59507)
---

diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el
index ecc5f7e47bd..2dd04174f54 100644
--- a/lisp/emacs-lisp/loaddefs-gen.el
+++ b/lisp/emacs-lisp/loaddefs-gen.el
@@ -108,21 +108,26 @@ scanning for autoloads and will be in the `load-path'."
   (let* ((name (file-relative-name file (file-name-directory outfile)))
          (names '())
          (dir (file-name-directory outfile)))
-    ;; If `name' has directory components, only keep the
-    ;; last few that are really needed.
-    (while name
-      (setq name (directory-file-name name))
-      (push (file-name-nondirectory name) names)
-      (setq name (file-name-directory name)))
-    (while (not name)
-      (cond
-       ((null (cdr names)) (setq name (car names)))
-       ((file-exists-p (expand-file-name "subdirs.el" dir))
-        ;; FIXME: here we only check the existence of subdirs.el,
-        ;; without checking its content.  This makes it generate wrong load
-        ;; names for cases like lisp/term which is not added to load-path.
-        (setq dir (expand-file-name (pop names) dir)))
-       (t (setq name (mapconcat #'identity names "/")))))
+    ;; If `name' lives inside an ancestor directory of OUTFILE, only
+    ;; keep the last few leading directories that are really needed.
+    ;; (It will always live in an ancestor directory of OUTFILE on
+    ;; Posix systems, but on DOS/Windows it could not be, if FILE and
+    ;; OUTFILE are on different drives.)
+    (when (not (file-name-absolute-p name))
+      (while name
+        (setq name (directory-file-name name))
+        (push (file-name-nondirectory name) names)
+        (setq name (file-name-directory name)))
+      (while (not name)
+        (cond
+         ((null (cdr names)) (setq name (car names)))
+         ((file-exists-p (expand-file-name "subdirs.el" dir))
+          ;; FIXME: here we only check the existence of subdirs.el,
+          ;; without checking its content.  This makes it generate
+          ;; wrong load names for cases like lisp/term which is not
+          ;; added to load-path.
+          (setq dir (expand-file-name (pop names) dir)))
+         (t (setq name (mapconcat #'identity names "/"))))))
     (if (string-match "\\.elc?\\(\\.\\|\\'\\)" name)
         (substring name 0 (match-beginning 0))
       name)))