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: Sun, 01 Feb 2015 08:02:29 +0100 Message-ID: <87lhkiru62.fsf@gmail.com> References: <87wq4dpqib.fsf@gmail.com> <87wq44su8v.fsf@gmail.com> <877fw3789y.fsf@gmail.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: ger.gmane.org 1422774173 32550 80.91.229.3 (1 Feb 2015 07:02:53 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sun, 1 Feb 2015 07:02:53 +0000 (UTC) Cc: Stefan Monnier , emacs-devel To: bruce.connor.am@gmail.com Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sun Feb 01 08:02:52 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 1YHoYV-0004Pn-Oo for ged-emacs-devel@m.gmane.org; Sun, 01 Feb 2015 08:02:52 +0100 Original-Received: from localhost ([::1]:43751 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YHoYV-00056m-9N for ged-emacs-devel@m.gmane.org; Sun, 01 Feb 2015 02:02:51 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:36341) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YHoYH-00056d-KM for emacs-devel@gnu.org; Sun, 01 Feb 2015 02:02:39 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1YHoYD-0002K0-FM for emacs-devel@gnu.org; Sun, 01 Feb 2015 02:02:37 -0500 Original-Received: from mail-we0-x22a.google.com ([2a00:1450:400c:c03::22a]:51602) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YHoYD-0002Jw-5N for emacs-devel@gnu.org; Sun, 01 Feb 2015 02:02:33 -0500 Original-Received: by mail-we0-f170.google.com with SMTP id w55so28312217wes.1 for ; Sat, 31 Jan 2015 23:02:32 -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=ahNvklxRYJx2pgMwpQG/k7Ne/ijxMcyKCUzNWZecK2k=; b=kM6nZDlHFkW8fGnqHXbTo8oQICTNp5YIN6C5bnZ8+Jy2McPhQKFO9uU1pLMfDibppc o86foylg5TMrcnzKIs/l/19Vfv8O4eAMR67sYO5vhIwAGXG1PEDrJGxgZCkuK3R9lmgo KD0ALvsbux9O1WVz2bQrzmHK114uSLblqqPQZFk9RmkXnGohHvu7xSAojxfy6XHSr3G0 pQH1xr+8q1/M9hLnzGFq5NlsWs3Z+96cCW7LSH6xOmMZiTjMRieP/SYKC8pgi2BfMFZN Pxe9OKZf+wUBmWxBmkIiR7lC8hz8GQnzQDltpl9L2tkK+08kjE/C3ML0sHCGv/yZxS4T q+xw== X-Received: by 10.194.202.232 with SMTP id kl8mr20215729wjc.75.1422774152510; Sat, 31 Jan 2015 23:02:32 -0800 (PST) Original-Received: from dell-14z (lbe83-2-78-243-104-167.fbx.proxad.net. [78.243.104.167]) by mx.google.com with ESMTPSA id hv5sm22177648wjb.16.2015.01.31.23.02.30 (version=TLSv1.2 cipher=RC4-SHA bits=128/128); Sat, 31 Jan 2015 23:02:31 -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:c03::22a 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:182163 Archived-At: Artur Malabarba writes: >> While you're at it: if package-selected-packages (or whatever name you >> end up using) is not yet set (e.g. still nil), you could guess an >> initial value: take the list of packages that are installed and are not >> required by other installed packages. I.e. choose as initial value of >> package-selected-packages the smallest set of packages such that >> package-autoremove won't have anything to remove. > > I'll work on this, and then I'll add it in once this patch is applied. So here again my final patch: - packages-installed-directly renamed to package-selected-packages - remove customize call in package-autoremove. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 88fc950..74a441b 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 package-selected-packages 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 `package-selected-packages'. +When called from lisp you will have to use ARG if you want to +simulate an interactive call to add PKG to `package-selected-packages'." (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 package-selected-packages))) + (customize-save-variable 'package-selected-packages + (cons pkg package-selected-packages))) (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 package-selected-packages) + (push name package-selected-packages) + (customize-save-variable 'package-selected-packages + package-selected-packages)) pkg-desc)) ;;;###autoload @@ -1388,26 +1421,120 @@ 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 `package-selected-packages' are installed. +If some packages are not installed propose to install them." + (interactive) + (cl-loop for p in package-selected-packages + 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-desc &optional pkg-list) + "Check in PKG-LIST if PKG-DESC is used elsewhere as dependency. + +When not specified, PKG-LIST default to `package-alist' +with PKG-DESC entry removed. +Returns the first package found in PKG-LIST where PKG is used as dependency." + (unless (string= (package-desc-status pkg-desc) "obsolete") + (let ((pkg (package-desc-name pkg-desc))) + (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 +`package-selected-packages' and their dependencies +will be deleted." + (interactive) + (let* (old-direct + (needed (cl-loop for p in package-selected-packages + 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 package-selected-packages)) + 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)) + (message "Nothing to autoremove"))))) (defun package-archive-base (desc) "Return the archive containing the package NAME." @@ -1721,7 +1848,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 +2305,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