Re: package.el dependencies

[Thierry Volpiatto]

Stefan Monnier <address@hidden> writes:

>>>> 1) Prevent (or warn) deleting a package if it is already used by another
>>>> package as dependency.
>>> That'd be nice.
>> Fixed,
>
> Thanks Thierry.
>
>> assuming that when upgrading a package, deletion of old version
>> is made AFTER installing new version.
>
> Good,

Here the patch:

--8<---------------cut here---------------start------------->8---
20c8e5d05f8e8e8996cf80f03f35335b328fdd94 HEAD package_autoremove
Author: Thierry Volpiatto <address@hidden>
Date:   Sun Jan 25 10:13:28 2015 +0100

    Prevent deleting a package needed as dependency by another package.
    
    * lisp/emacs-lisp/package.el (package-used-elsewhere-p): New.
    (package-delete): Use it.

1 file changed, 30 insertions(+), 18 deletions(-)
 lisp/emacs-lisp/package.el | 48 +++++++++++++++++++++++++++++-----------------

        Modified   lisp/emacs-lisp/package.el
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 88fc950..6923de5 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1388,26 +1388,38 @@ The file can either be a tar file or an Emacs Lisp 
file."
       (when (string-match "\\.tar\\'" file) (tar-mode)))
     (package-install-from-buffer)))
 
+(defun package-used-elsewhere-p (pkg)
+  "Check if PKG is used elsewhere as dependency.
+Argument PKG is a symbol."
+  (cl-loop with alist = (remove (assoc pkg package-alist) package-alist)
+           for p in alist thereis
+           (member pkg (mapcar 'car (package-desc-reqs (cadr p))))))
+
 (defun package-delete (pkg-desc)
   (let ((dir (package-desc-dir pkg-desc)))
-    (if (not (string-prefix-p (file-name-as-directory
-                               (expand-file-name package-user-dir))
-                              (expand-file-name dir)))
-        ;; Don't delete "system" packages.
-       (error "Package `%s' is a system package, not deleting"
-               (package-desc-full-name pkg-desc))
-      (delete-directory dir t t)
-      ;; Remove NAME-VERSION.signed file.
-      (let ((signed-file (concat dir ".signed")))
-       (if (file-exists-p signed-file)
-           (delete-file signed-file)))
-      ;; Update package-alist.
-      (let* ((name (package-desc-name pkg-desc))
-             (pkgs (assq name package-alist)))
-        (delete pkg-desc pkgs)
-        (unless (cdr pkgs)
-          (setq package-alist (delq pkgs package-alist))))
-      (message "Package `%s' deleted." (package-desc-full-name pkg-desc)))))
+    (cond ((not (string-prefix-p (file-name-as-directory
+                                  (expand-file-name package-user-dir))
+                                 (expand-file-name dir)))
+           ;; Don't delete "system" packages.
+           (error "Package `%s' is a system package, not deleting"
+                  (package-desc-full-name pkg-desc)))
+          ((package-used-elsewhere-p (elt pkg-desc 1))
+           ;; Don't delete packages used as dependency elsewhere.
+           (error "Package `%s' is used elsewhere as dependency, not deleting"
+                  (package-desc-full-name pkg-desc)))
+          (t 
+           (delete-directory dir t t)
+           ;; Remove NAME-VERSION.signed file.
+           (let ((signed-file (concat dir ".signed")))
+             (if (file-exists-p signed-file)
+                 (delete-file signed-file)))
+           ;; Update package-alist.
+           (let* ((name (package-desc-name pkg-desc))
+                  (pkgs (assq name package-alist)))
+             (delete pkg-desc pkgs)
+             (unless (cdr pkgs)
+               (setq package-alist (delq pkgs package-alist))))
+           (message "Package `%s' deleted." (package-desc-full-name 
pkg-desc))))))
 
 (defun package-archive-base (desc)
   "Return the archive containing the package NAME."
--8<---------------cut here---------------end--------------->8---

-- 
Thierry
Get my Gnupg key:
gpg --keyserver pgp.mit.edu --recv-keys 59F29997