From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Thierry Volpiatto Newsgroups: gmane.emacs.devel Subject: Re: package.el dependencies Date: Wed, 28 Jan 2015 13:42:45 +0100 Message-ID: <878ugndqka.fsf@gmail.com> References: <87wq4dpqib.fsf@gmail.com> <87zj93uzuo.fsf@gmail.com> <87wq47uvwe.fsf@gmail.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: ger.gmane.org 1422448986 26822 80.91.229.3 (28 Jan 2015 12:43:06 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 28 Jan 2015 12:43:06 +0000 (UTC) Cc: emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Jan 28 13:43:06 2015 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1YGRxX-0002xV-IG for ged-emacs-devel@m.gmane.org; Wed, 28 Jan 2015 13:43:03 +0100 Original-Received: from localhost ([::1]:53032 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YGRxX-0003c7-2f for ged-emacs-devel@m.gmane.org; Wed, 28 Jan 2015 07:43:03 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:48882) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YGRxS-0003bv-O4 for emacs-devel@gnu.org; Wed, 28 Jan 2015 07:43:00 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1YGRxP-0004Fs-FA for emacs-devel@gnu.org; Wed, 28 Jan 2015 07:42:58 -0500 Original-Received: from mail-wi0-x235.google.com ([2a00:1450:400c:c05::235]:42120) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YGRxP-0004Fb-5U for emacs-devel@gnu.org; Wed, 28 Jan 2015 07:42:55 -0500 Original-Received: by mail-wi0-f181.google.com with SMTP id fb4so11593889wid.2 for ; Wed, 28 Jan 2015 04:42:54 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=references:from:to:cc:subject:in-reply-to:date:message-id :mime-version:content-type; bh=GaRHjajCmDaNK0bND837BbkKweU6fuCjS7/RAng6p0M=; b=WCLrOJaPLFVLxigLG0n4oWVFKNa9whpkB2zP8a4PNKslrP84afBy2DPa8PxdFb2prA GZnDH+rcNp3FpPmvliC3JAMKCuMa1kp0NylEFSsOylilPESD6TP2lD5MUPrPgKByRQxs Rf6zeWQW6/9MwWDIUnmwfA1XqE2KV3tIixRvLqdHbLWSdW5YGl7DAmYS3tDh61O2CyYs y0MVyvG2aDPKiJIbywwXtAqxpUGs55Np6g9Ps8D5KlATu4peKSt1l9KDsL/rT65X/m3s wKqongxTiJ0vJhudMf8MAaZtlUFzcR8gh/SSAGWblupk54DeQu0YNeMKXn40SQsIBI9J 6JHg== X-Received: by 10.180.182.72 with SMTP id ec8mr6780170wic.53.1422448974367; Wed, 28 Jan 2015 04:42:54 -0800 (PST) Original-Received: from dell-14z ([37.163.92.236]) by mx.google.com with ESMTPSA id d6sm2687472wic.1.2015.01.28.04.42.49 (version=TLSv1.2 cipher=RC4-SHA bits=128/128); Wed, 28 Jan 2015 04:42:53 -0800 (PST) In-reply-to: <87wq47uvwe.fsf@gmail.com> X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-Received-From: 2a00:1450:400c:c05::235 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:181901 Archived-At: Thierry Volpiatto writes: > Thierry Volpiatto writes: > >> I will not have a good connection until next week, so I am unable to >> push a branch, so I am just attaching patch of all my changes against >> package.el here. > > So to summarize what this patch does: > > 1) Returns an error when trying to delete a package already used as > dependency by another package. The first package already using the > package we are trying to delete is returned in error message. > > 2) When installing a package explicitely (interactively) record this > package in a variable named `packages-installed-directly'. > > 3) Provide an autoremove command that remove all unneeded packages, i.e > the packages that are not needed as dependency (directly or indirectly) > by one of `packages-installed-directly'. So here the last version, with tiny changes since the last, tested and working fine here, please review, possibly install it so that I can make easily corrections if needed, thanks. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 88fc950..c80ea4d 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -333,6 +333,15 @@ contents of the archive." :group 'package :version "24.4") +(defcustom packages-installed-directly nil + "Store here packages installed explicitely by user. +This variable will be feeded automaticaly by emacs, +so you should not modify it yourself. +This variable will be used by `package-autoremove' to decide +which packages are no more needed." + :group 'package + :type '(repeat (choice symbol))) + (defvar package--default-summary "No description available.") (cl-defstruct (package-desc @@ -1187,10 +1196,13 @@ using `package-compute-transaction'." (mapc #'package-install-from-archive packages)) ;;;###autoload -(defun package-install (pkg) +(defun package-install (pkg &optional arg) "Install the package PKG. PKG can be a package-desc or the package name of one the available packages -in an archive in `package-archives'. Interactively, prompt for its name." +in an archive in `package-archives'. Interactively, prompt for its name +and add PKG to `packages-installed-directly'. +When called from lisp you will have to use ARG if you want to +simulate an interactive call to add PKG to `packages-installed-directly'." (interactive (progn ;; Initialize the package system to get the list of package @@ -1206,7 +1218,11 @@ in an archive in `package-archives'. Interactively, prompt for its name." (unless (package-installed-p (car elt)) (symbol-name (car elt)))) package-archive-contents)) - nil t))))) + nil t)) + "\p"))) + (when (and arg (not (memq pkg packages-installed-directly))) + (customize-save-variable 'packages-installed-directly + (cons pkg packages-installed-directly))) (package-download-transaction (if (package-desc-p pkg) (package-compute-transaction (list pkg) @@ -1368,10 +1384,15 @@ Downloads and installs required packages as needed." (package-buffer-info))))) ;; Download and install the dependencies. (let* ((requires (package-desc-reqs pkg-desc)) + (name (package-desc-name pkg-desc)) (transaction (package-compute-transaction nil requires))) (package-download-transaction transaction)) ;; Install the package itself. (package-unpack pkg-desc) + (unless (memq name packages-installed-directly) + (push name packages-installed-directly) + (customize-save-variable 'packages-installed-directly + packages-installed-directly)) pkg-desc)) ;;;###autoload @@ -1388,26 +1409,105 @@ 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-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))))) +(defun package--get-deps (pkg &optional only) + (let* ((pkg-desc (cadr (assq pkg package-alist))) + (direct-deps (cl-loop for p in (package-desc-reqs pkg-desc) + for name = (car p) + when (assq name package-alist) + collect name)) + (indirect-deps (unless (eq only 'direct) + (cl-loop for p in direct-deps + for dep = (cadr (assq p package-alist)) + when (and dep (assq p package-alist)) + append (mapcar 'car + (package-desc-reqs + dep)))))) + (cl-case only + (direct direct-deps) + (separate (list direct-deps indirect-deps)) + (indirect indirect-deps) + (t (append direct-deps indirect-deps))))) + +(defun package-used-elsewhere-p (pkg &optional pkg-list) + "Check in PKG-LIST if PKG is used elsewhere as dependency. +When not specified, PKG-LIST default to `package-alist' with PKG entry removed. +Argument PKG is a symbol. +Returns the first package found in PKG-LIST where PKG is used as dependency." + (cl-loop with alist = (or pkg-list + (remove (assq pkg package-alist) + package-alist)) + for p in alist thereis + (and (memq pkg (mapcar 'car (package-desc-reqs (cadr p)))) + (car p)))) + +(defun package-delete (pkg-desc &optional force) + "Delete package PKG-DESC. + +Argument PKG-DESC is a full description of package as vector. +When package is used elsewhere as dependency of another package, +refuse deleting it and return an error. +If FORCE is non--nil package will be deleted even if it is used +elsewhere." + (let ((dir (package-desc-dir pkg-desc)) + (name (package-desc-name pkg-desc)) + pkg-used-elsewhere-by) + (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))) + ((and (null force) + (setq pkg-used-elsewhere-by + (package-used-elsewhere-p name))) + ;; Don't delete packages used as dependency elsewhere. + (error "Package `%s' is used by `%s' as dependency, not deleting" + (package-desc-full-name pkg-desc) + pkg-used-elsewhere-by)) + (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 ((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)))))) + +;;;###autoload +(defun package-autoremove () + "Remove packages that are no more needed. + +Packages that are no more needed by other packages in +`packages-installed-directly' and their dependencies +will be deleted." + (interactive) + (let* (old-direct + (needed (cl-loop for p in packages-installed-directly + if (assq p package-alist) + append (package--get-deps p) into lst + else do (push p old-direct) + finally return lst))) + (cl-loop for p in (mapcar 'car package-alist) + unless (or (memq p needed) + (memq p packages-installed-directly)) + collect p into lst + finally (if lst + (when (y-or-n-p (format "%s packages will be deleted:\n%s, proceed? " + (length lst) + (mapconcat 'symbol-name lst ", "))) + (mapc (lambda (p) + (package-delete (cadr (assq p package-alist)) t)) + lst) + (customize-save-variable + 'packages-installed-directly + (cl-loop for p in packages-installed-directly + unless (memq p old-direct) + collect p))) + (message "Nothing to autoremove"))))) (defun package-archive-base (desc) "Return the archive containing the package NAME." @@ -1721,7 +1821,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (let ((pkg-desc (button-get button 'package-desc))) (when (y-or-n-p (format "Install package `%s'? " (package-desc-full-name pkg-desc))) - (package-install pkg-desc) + (package-install pkg-desc 1) (revert-buffer nil t) (goto-char (point-min))))) @@ -2178,7 +2278,7 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." (length install-list) (mapconcat #'package-desc-full-name install-list ", "))))) - (mapc 'package-install install-list))) + (mapc (lambda (p) (package-install p 1)) install-list))) ;; Delete packages, prompting if necessary. (when delete-list (if (or -- Thierry Get my Gnupg key: gpg --keyserver pgp.mit.edu --recv-keys 59F29997