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: Fri, 30 Jan 2015 06:38:40 +0100 Message-ID: <87wq44su8v.fsf@gmail.com> References: <87wq4dpqib.fsf@gmail.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit X-Trace: ger.gmane.org 1422596344 26609 80.91.229.3 (30 Jan 2015 05:39:04 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Fri, 30 Jan 2015 05:39:04 +0000 (UTC) Cc: emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Fri Jan 30 06:39:04 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 1YH4II-0002qH-Ou for ged-emacs-devel@m.gmane.org; Fri, 30 Jan 2015 06:39:03 +0100 Original-Received: from localhost ([::1]:34845 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YH4IH-0007dO-TC for ged-emacs-devel@m.gmane.org; Fri, 30 Jan 2015 00:39:01 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:34535) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YH4IC-0007ZT-4g for emacs-devel@gnu.org; Fri, 30 Jan 2015 00:38:58 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1YH4I8-0004Vn-Pa for emacs-devel@gnu.org; Fri, 30 Jan 2015 00:38:56 -0500 Original-Received: from mail-wg0-x233.google.com ([2a00:1450:400c:c00::233]:33188) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YH4I8-0004Vj-DZ for emacs-devel@gnu.org; Fri, 30 Jan 2015 00:38:52 -0500 Original-Received: by mail-wg0-f51.google.com with SMTP id k14so24877083wgh.10 for ; Thu, 29 Jan 2015 21:38:51 -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:content-transfer-encoding; bh=J0uSG3wbJ0Kvj5nBKIR1KEWpncFDZKPpSULvStlJuB8=; b=oqQuqL2lNnxLCftezCZYeZFaThkxUFdMzw8N4h0c1JbltLJ6MITRE4zkAySvW4mVfW mtVnknAc2Y58PxuLsrw6Y3D1WSvkJhl4NIFHB9XX/ThLBrLrwSPoLD1lr1opL+I8bYvY HOFWdZmpbVYLDU99qnS4aio5EWjr6D4l60rKb8sZD7kuYJBXC6cSw0CN0oViZueVi5UE K2uFNa+BtnDxXDm3uyDlVFScpIlF3Eqcszn1EuqjJ9U8L4HPE1jRyXoZLbliihBAkXyv QYc0e4tdZAYmT7GgZkaKFaYzhGSam4PSC/vn9hWf5tPGI4r8SA8SJfPvP8tRCuSg6yc/ bb6g== X-Received: by 10.180.198.240 with SMTP id jf16mr1261359wic.27.1422596330947; Thu, 29 Jan 2015 21:38:50 -0800 (PST) Original-Received: from dell-14z ([37.162.145.83]) by mx.google.com with ESMTPSA id hv5sm13312927wjb.16.2015.01.29.21.38.45 (version=TLSv1.2 cipher=RC4-SHA bits=128/128); Thu, 29 Jan 2015 21:38:49 -0800 (PST) In-reply-to: X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-Received-From: 2a00:1450:400c:c00::233 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:182015 Archived-At: Stefan Monnier writes: >> 1) Prevent (or warn) deleting a package if it is already used by another >> package as dependency. > > That'd be nice. > >> 2) Store a list of packages installed explicitely (not as dependency) >> and provide an autoremove function such as apt-get autoremove. > > I already asked for help writing that (not much luck so far, tho), so > yes, that'd be very welcome, So find here my final patch, I haven't renamed packages-installed-directly, feel free to rename it as needed. Changes from master to working tree 2 files changed, 193 insertions(+), 37 deletions(-) lisp/ChangeLog | 25 ++++++ lisp/emacs-lisp/package.el | 205 +++++++++++++++++++++++++++++++++++++-------- Modified lisp/ChangeLog diff --git a/lisp/ChangeLog b/lisp/ChangeLog index eb6ef6b..06753eb 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,28 @@ +2015-01-30 Thierry Volpiatto + + * lisp/emacs-lisp/package.el: + + Package should not allow deleting packages used elsewhere. + (package-used-elsewhere-p): New. + (package-delete): Use it, return now an error when trying to delete + a package used as dependency by another package. + + Add a reinstall package command. + (package-reinstall): New. + + Add a package-autoremove command. + (packages-installed-directly): New user var. + (package-install): Add an optional arg to notify interactive use. + Fix docstring. Save installed package to packages-installed-directly. + (package-install-from-buffer): Same. + (package-user-selected-packages-install): Allow installing all + packages in packages-installed-directly at once. + (package--get-deps): New. + (package-autoremove): New + (package-install-button-action): Call package-install with interactive arg. + (package-menu-execute): Same but only for only for not installed packages. + + 2015-01-26 Fabián Ezequiel Gallina python.el: New non-global state dependent indentation engine. Modified lisp/emacs-lisp/package.el diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 88fc950..df27be6 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -333,6 +333,17 @@ 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 automatically by emacs, +when installing a new package. +This variable will be used by `package-autoremove' to decide +which packages are no more needed. +You can use it to (re)install packages on other machines +by running `package-user-selected-packages-install'." + :group 'package + :type '(repeat (choice symbol))) + (defvar package--default-summary "No description available.") (cl-defstruct (package-desc @@ -1187,10 +1198,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 +1220,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) @@ -1214,6 +1232,16 @@ in an archive in `package-archives'. Interactively, prompt for its name." (package-compute-transaction () (list (list pkg)))))) +;;;###autoload +(defun package-reinstall (pkg) + "Reinstall package PKG." + (interactive (list (intern (completing-read + "Reinstall package: " + (mapcar 'symbol-name + (mapcar 'car package-alist)))))) + (package-delete (cadr (assq pkg package-alist)) t) + (package-install pkg)) + (defun package-strip-rcs-id (str) "Strip RCS version ID from the version string STR. If the result looks like a dotted numeric version, return it. @@ -1354,24 +1382,29 @@ is derived from the main .el file in the directory. Downloads and installs required packages as needed." (interactive) - (let ((pkg-desc - (cond - ((derived-mode-p 'dired-mode) - ;; This is the only way a package-desc object with a `dir' - ;; desc-kind can be created. Such packages can't be - ;; uploaded or installed from archives, they can only be - ;; installed from local buffers or directories. - (package-dir-info)) - ((derived-mode-p 'tar-mode) - (package-tar-file-info)) - (t - (package-buffer-info))))) + (let* ((pkg-desc + (cond + ((derived-mode-p 'dired-mode) + ;; This is the only way a package-desc object with a `dir' + ;; desc-kind can be created. Such packages can't be + ;; uploaded or installed from archives, they can only be + ;; installed from local buffers or directories. + (package-dir-info)) + ((derived-mode-p 'tar-mode) + (package-tar-file-info)) + (t + (package-buffer-info)))) + (name (package-desc-name pkg-desc))) ;; Download and install the dependencies. (let* ((requires (package-desc-reqs 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 +1421,122 @@ 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))))) + +;;;###autoload +(defun package-user-selected-packages-install () + "Ensure packages in `packages-installed-directly' are installed. +If some packages are not installed propose to install them." + (interactive) + (cl-loop for p in packages-installed-directly + unless (package-installed-p p) + collect p into lst + finally + (if lst + (when (y-or-n-p + (format "%s packages will be installed:\n%s, proceed?" + (length lst) + (mapconcat 'symbol-name lst ", "))) + (mapc 'package-install lst)) + (message "All your packages are already installed")))) + +(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 +1850,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 +2307,9 @@ 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 (and (null (package-installed-p 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