masscollaborationlabs/emacs
2
0
Fork 0
mirror of https://github.com/masscollaborationlabs/emacs.git synced 2025-07-04 11:23:24 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Avoid using symbolic links when installing local VC packages

Browse source 
* lisp/emacs-lisp/package-vc.el (package-vc--main-file): Use
`expand-file-name' to support :lisp-dir entries outside of the
elpa directory.
(package-vc--unpack-1): Same as above.
(package-vc-install-from-checkout): Instead of creating a
symlink to the requested directory, create an empty directory
and use autoload indirections, analogously to checkouts with
Lisp code in a subdirectory.

(Bug#78017)
This commit is contained in:
Philip Kaludercic 2025-04-30 17:05:08 +02:00
parent b81f937e60
commit 4226eb2b20
No known key found for this signature in database
1 changed files with 10 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

19
lisp/emacs-lisp/package-vc.el
View file

@ -241,10 +241,10 @@ asynchronously."
(cl-assert (package-vc-p pkg-desc)) (cl-assert (package-vc-p pkg-desc))
(let* ((pkg-spec (package-vc--desc->spec pkg-desc)) (let* ((pkg-spec (package-vc--desc->spec pkg-desc))
(name (symbol-name (package-desc-name pkg-desc))) (name (symbol-name (package-desc-name pkg-desc)))
(directory (file-name-concat (directory (expand-file-name
(plist-get pkg-spec :lisp-dir)
(or (package-desc-dir pkg-desc) (or (package-desc-dir pkg-desc)
(expand-file-name name package-user-dir)) (expand-file-name name package-user-dir))))
(plist-get pkg-spec :lisp-dir)))
(file (expand-file-name (file (expand-file-name
(or (plist-get pkg-spec :main-file) (or (plist-get pkg-spec :main-file)
(concat name ".el")) (concat name ".el"))
@ -460,7 +460,7 @@ identify a package as a VC package later on), building
documentation and marking the package as installed." documentation and marking the package as installed."
(let* ((pkg-spec (package-vc--desc->spec pkg-desc)) (let* ((pkg-spec (package-vc--desc->spec pkg-desc))
(lisp-dir (plist-get pkg-spec :lisp-dir)) (lisp-dir (plist-get pkg-spec :lisp-dir))
(lisp-path (file-name-concat pkg-dir lisp-dir)) (lisp-path (expand-file-name lisp-dir pkg-dir))
missing) missing)
;; In case the package was installed directly from source, the ;; In case the package was installed directly from source, the
@ -508,7 +508,7 @@ documentation and marking the package as installed."
(with-temp-buffer (with-temp-buffer
(insert ";; Autoload indirection for package-vc\n\n") (insert ";; Autoload indirection for package-vc\n\n")
(prin1 `(load (expand-file-name (prin1 `(load (expand-file-name
,(file-name-concat lisp-dir auto-name) ,(expand-file-name auto-name lisp-dir)
(or (and load-file-name (or (and load-file-name
(file-name-directory load-file-name)) (file-name-directory load-file-name))
(car load-path)))) (car load-path))))
@ -924,16 +924,17 @@ for the NAME of the package to set up."
(read-string (read-string
(format-prompt "Package name" base) (format-prompt "Package name" base)
nil nil base))))) nil nil base)))))
(unless (vc-responsible-backend dir)
(user-error "Directory %S is not under version control" dir))
(package-vc--archives-initialize) (package-vc--archives-initialize)
(let* ((name (or name (file-name-base (directory-file-name dir)))) (let* ((name (or name (file-name-base (directory-file-name dir))))
(pkg-dir (expand-file-name name package-user-dir))) (pkg-dir (expand-file-name name package-user-dir))
(package-vc-selected-packages
(cons (list name :lisp-dir (expand-file-name dir))
package-vc-selected-packages)))
(when (file-exists-p pkg-dir) (when (file-exists-p pkg-dir)
(if (yes-or-no-p (format "Overwrite previous checkout for package `%s'?" name)) (if (yes-or-no-p (format "Overwrite previous checkout for package `%s'?" name))
(package--delete-directory pkg-dir) (package--delete-directory pkg-dir)
(error "There already exists a checkout for %s" name))) (error "There already exists a checkout for %s" name)))
(make-symbolic-link (expand-file-name dir) pkg-dir) (make-directory pkg-dir t)
(package-vc--unpack-1 (package-vc--unpack-1
(package-desc-create (package-desc-create
:name (intern name) :name (intern name)