elpa/epl-20180205.2049/epl.el

   1 ;;; epl.el --- Emacs Package Library -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2013-2015 Sebastian Wiesner
   4 ;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2015 Free Software
   5
   6 ;; Author: Sebastian Wiesner <swiesner@lunaryorn.com>
   7 ;; Maintainer: Johan Andersson <johan.rejeep@gmail.com>
   8 ;;     Sebastian Wiesner <swiesner@lunaryorn.com>
   9 ;; Version: 0.10-cvs
  10 ;; Package-Version: 20180205.2049
  11 ;; Package-Requires: ((cl-lib "0.3"))
  12 ;; Keywords: convenience
  13 ;; URL: http://github.com/cask/epl
  14
  15 ;; This file is NOT part of GNU Emacs.
  16
  17 ;; This program is free software; you can redistribute it and/or modify
  18 ;; it under the terms of the GNU General Public License as published by
  19 ;; the Free Software Foundation, either version 3 of the License, or
  20 ;; (at your option) any later version.
  21
  22 ;; This program is distributed in the hope that it will be useful,
  23 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  24 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  25 ;; GNU General Public License for more details.
  26
  27 ;; You should have received a copy of the GNU General Public License
  28 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  29
  30 ;;; Commentary:
  31
  32 ;; A package management library for Emacs, based on package.el.
  33
  34 ;; The purpose of this library is to wrap all the quirks and hassle of
  35 ;; package.el into a sane API.
  36
  37 ;; The following functions comprise the public interface of this library:
  38
  39 ;;; Package directory selection
  40
  41 ;; `epl-package-dir' gets the directory of packages.
  42
  43 ;; `epl-default-package-dir' gets the default package directory.
  44
  45 ;; `epl-change-package-dir' changes the directory of packages.
  46
  47 ;;; Package system management
  48
  49 ;; `epl-initialize' initializes the package system and activates all
  50 ;; packages.
  51
  52 ;; `epl-reset' resets the package system.
  53
  54 ;; `epl-refresh' refreshes all package archives.
  55
  56 ;; `epl-add-archive' adds a new package archive.
  57
  58 ;;; Package objects
  59
  60 ;; Struct `epl-requirement' describes a requirement of a package with `name' and
  61 ;; `version' slots.
  62
  63 ;; `epl-requirement-version-string' gets a requirement version as string.
  64
  65 ;; Struct `epl-package' describes an installed or installable package with a
  66 ;; `name' and some internal `description'.
  67
  68 ;; `epl-package-version' gets the version of a package.
  69
  70 ;; `epl-package-version-string' gets the version of a package as string.
  71
  72 ;; `epl-package-summary' gets the summary of a package.
  73
  74 ;; `epl-package-requirements' gets the requirements of a package.
  75
  76 ;; `epl-package-directory' gets the installation directory of a package.
  77
  78 ;; `epl-package-from-buffer' creates a package object for the package contained
  79 ;; in the current buffer.
  80
  81 ;; `epl-package-from-file' creates a package object for a package file, either
  82 ;; plain lisp or tarball.
  83
  84 ;; `epl-package-from-descriptor-file' creates a package object for a package
  85 ;; description (i.e. *-pkg.el) file.
  86
  87 ;;; Package database access
  88
  89 ;; `epl-package-installed-p' determines whether a package is installed, either
  90 ;; built-in or explicitly installed.
  91
  92 ;; `epl-package-outdated-p' determines whether a package is outdated, that is,
  93 ;; whether a package with a higher version number is available.
  94
  95 ;; `epl-built-in-packages', `epl-installed-packages', `epl-outdated-packages'
  96 ;; and `epl-available-packages' get all packages built-in, installed, outdated,
  97 ;; or available for installation respectively.
  98
  99 ;; `epl-find-built-in-package', `epl-find-installed-packages' and
 100 ;; `epl-find-available-packages' find built-in, installed and available packages
 101 ;; by name.
 102
 103 ;; `epl-find-upgrades' finds all upgradable packages.
 104
 105 ;; `epl-built-in-p' return true if package is built-in to Emacs.
 106
 107 ;;; Package operations
 108
 109 ;; `epl-install-file' installs a package file.
 110
 111 ;; `epl-package-install' installs a package.
 112
 113 ;; `epl-package-delete' deletes a package.
 114
 115 ;; `epl-upgrade' upgrades packages.
 116
 117 ;;; Code:
 118
 119 (require 'cl-lib)
 120 (require 'package)
 121
 122 \f
 123 (unless (fboundp #'define-error)
 124   ;; `define-error' for 24.3 and earlier, copied from subr.el
 125   (defun define-error (name message &optional parent)
 126     "Define NAME as a new error signal.
 127 MESSAGE is a string that will be output to the echo area if such an error
 128 is signaled without being caught by a `condition-case'.
 129 PARENT is either a signal or a list of signals from which it inherits.
 130 Defaults to `error'."
 131     (unless parent (setq parent 'error))
 132     (let ((conditions
 133            (if (consp parent)
 134                (apply #'append
 135                       (mapcar (lambda (parent)
 136                                 (cons parent
 137                                       (or (get parent 'error-conditions)
 138                                           (error "Unknown signal `%s'" parent))))
 139                               parent))
 140              (cons parent (get parent 'error-conditions)))))
 141       (put name 'error-conditions
 142            (delete-dups (copy-sequence (cons name conditions))))
 143       (when message (put name 'error-message message)))))
 144
 145 (defsubst epl--package-desc-p (package)
 146   "Whether PACKAGE is a `package-desc' object.
 147
 148 Like `package-desc-p', but return nil, if `package-desc-p' is not
 149 defined as function."
 150   (and (fboundp 'package-desc-p) (package-desc-p package)))
 151
 152 \f
 153 ;;; EPL errors
 154 (define-error 'epl-error "EPL error")
 155
 156 (define-error 'epl-invalid-package "Invalid EPL package" 'epl-error)
 157
 158 (define-error 'epl-invalid-package-file "Invalid EPL package file"
 159   'epl-invalid-package)
 160
 161 \f
 162 ;;; Package directory
 163 (defun epl-package-dir ()
 164   "Get the directory of packages."
 165   package-user-dir)
 166
 167 (defun epl-default-package-dir ()
 168   "Get the default directory of packages."
 169   (eval (car (get 'package-user-dir 'standard-value))))
 170
 171 (defun epl-change-package-dir (directory)
 172   "Change the directory of packages to DIRECTORY."
 173   (setq package-user-dir directory)
 174   (epl-initialize))
 175
 176 \f
 177 ;;; Package system management
 178 (defvar epl--load-path-before-initialize nil
 179   "Remember the load path for `epl-reset'.")
 180
 181 (defun epl-initialize (&optional no-activate)
 182   "Load Emacs Lisp packages and activate them.
 183
 184 With NO-ACTIVATE non-nil, do not activate packages."
 185   (setq epl--load-path-before-initialize load-path)
 186   (package-initialize no-activate))
 187
 188 (defalias 'epl-refresh 'package-refresh-contents)
 189
 190 (defun epl-add-archive (name url)
 191   "Add a package archive with NAME and URL."
 192   (add-to-list 'package-archives (cons name url)))
 193
 194 (defun epl-reset ()
 195   "Reset the package system.
 196
 197 Clear the list of installed and available packages, the list of
 198 package archives and reset the package directory."
 199   (setq package-alist nil
 200         package-archives nil
 201         package-archive-contents nil
 202         load-path epl--load-path-before-initialize)
 203   (when (boundp 'package-obsolete-alist) ; Legacy package.el
 204     (setq package-obsolete-alist nil))
 205   (epl-change-package-dir (epl-default-package-dir)))
 206
 207 \f
 208 ;;; Package structures
 209 (cl-defstruct (epl-requirement
 210                (:constructor epl-requirement-create))
 211   "Structure describing a requirement.
 212
 213 Slots:
 214
 215 `name' The name of the required package, as symbol.
 216
 217 `version' The version of the required package, as version list."
 218   name
 219   version)
 220
 221 (defun epl-requirement-version-string (requirement)
 222   "The version of a REQUIREMENT, as string."
 223   (package-version-join (epl-requirement-version requirement)))
 224
 225 (cl-defstruct (epl-package (:constructor epl-package-create))
 226   "Structure representing a package.
 227
 228 Slots:
 229
 230 `name' The package name, as symbol.
 231
 232 `description' The package description.
 233
 234 The format package description varies between package.el
 235 variants.  For `package-desc' variants, it is simply the
 236 corresponding `package-desc' object.  For legacy variants, it is
 237 a vector `[VERSION REQS DOCSTRING]'.
 238
 239 Do not access `description' directly, but instead use the
 240 `epl-package' accessors."
 241   name
 242   description)
 243
 244 (defmacro epl-package-as-description (var &rest body)
 245   "Cast VAR to a package description in BODY.
 246
 247 VAR is a symbol, bound to an `epl-package' object.  This macro
 248 casts this object to the `description' object, and binds the
 249 description to VAR in BODY."
 250   (declare (indent 1))
 251   (unless (symbolp var)
 252     (signal 'wrong-type-argument (list #'symbolp var)))
 253   `(if (epl-package-p ,var)
 254        (let ((,var (epl-package-description ,var)))
 255          ,@body)
 256      (signal 'wrong-type-argument (list #'epl-package-p ,var))))
 257
 258 (defsubst epl-package--package-desc-p (package)
 259   "Whether the description of PACKAGE is a `package-desc'."
 260   (epl--package-desc-p (epl-package-description package)))
 261
 262 (defun epl-package-version (package)
 263   "Get the version of PACKAGE, as version list."
 264   (epl-package-as-description package
 265     (cond
 266      ((fboundp 'package-desc-version) (package-desc-version package))
 267      ;; Legacy
 268      ((fboundp 'package-desc-vers)
 269       (let ((version (package-desc-vers package)))
 270         (if (listp version) version (version-to-list version))))
 271      (:else (error "Cannot get version from %S" package)))))
 272
 273 (defun epl-package-version-string (package)
 274   "Get the version from a PACKAGE, as string."
 275   (package-version-join (epl-package-version package)))
 276
 277 (defun epl-package-summary (package)
 278   "Get the summary of PACKAGE, as string."
 279   (epl-package-as-description package
 280     (cond
 281      ((fboundp 'package-desc-summary) (package-desc-summary package))
 282      ((fboundp 'package-desc-doc) (package-desc-doc package)) ; Legacy
 283      (:else (error "Cannot get summary from %S" package)))))
 284
 285 (defsubst epl-requirement--from-req (req)
 286   "Create a `epl-requirement' from a `package-desc' REQ."
 287   (let  ((version (cadr req)))
 288     (epl-requirement-create :name (car req)
 289                             :version (if (listp version) version
 290                                        (version-to-list version)))))
 291
 292 (defun epl-package-requirements (package)
 293   "Get the requirements of PACKAGE.
 294
 295 The requirements are a list of `epl-requirement' objects."
 296   (epl-package-as-description package
 297     (mapcar #'epl-requirement--from-req (package-desc-reqs package))))
 298
 299 (defun epl-package-directory (package)
 300   "Get the directory PACKAGE is installed to.
 301
 302 Return the absolute path of the installation directory of
 303 PACKAGE, or nil, if PACKAGE is not installed."
 304   (cond
 305    ((fboundp 'package-desc-dir)
 306     (package-desc-dir (epl-package-description package)))
 307    ((fboundp 'package--dir)
 308     (package--dir (symbol-name (epl-package-name package))
 309                   (epl-package-version-string package)))
 310    (:else (error "Cannot get package directory from %S" package))))
 311
 312 (defun epl-package-->= (pkg1 pkg2)
 313   "Determine whether PKG1 is before PKG2 by version."
 314   (not (version-list-< (epl-package-version pkg1)
 315                        (epl-package-version pkg2))))
 316
 317 (defun epl-package--from-package-desc (package-desc)
 318   "Create an `epl-package' from a PACKAGE-DESC.
 319
 320 PACKAGE-DESC is a `package-desc' object, from recent package.el
 321 variants."
 322   (if (and (fboundp 'package-desc-name)
 323            (epl--package-desc-p package-desc))
 324       (epl-package-create :name (package-desc-name package-desc)
 325                           :description package-desc)
 326     (signal 'wrong-type-argument (list 'epl--package-desc-p package-desc))))
 327
 328 (defun epl-package--parse-info (info)
 329   "Parse a package.el INFO."
 330   (if (epl--package-desc-p info)
 331       (epl-package--from-package-desc info)
 332     ;; For legacy package.el, info is a vector [NAME REQUIRES DESCRIPTION
 333     ;; VERSION COMMENTARY].  We need to re-shape this vector into the
 334     ;; `package-alist' format [VERSION REQUIRES DESCRIPTION] to attach it to the
 335     ;; new `epl-package'.
 336     (let ((name (intern (aref info 0)))
 337           (info (vector (aref info 3) (aref info 1) (aref info 2))))
 338       (epl-package-create :name name :description info))))
 339
 340 (defun epl-package-from-buffer (&optional buffer)
 341   "Create an `epl-package' object from BUFFER.
 342
 343 BUFFER defaults to the current buffer.
 344
 345 Signal `epl-invalid-package' if the buffer does not contain a
 346 valid package file."
 347   (let ((info (with-current-buffer (or buffer (current-buffer))
 348                 (condition-case err
 349                     (package-buffer-info)
 350                   (error (signal 'epl-invalid-package (cdr err)))))))
 351     (epl-package--parse-info info)))
 352
 353 (defun epl-package-from-lisp-file (file-name)
 354   "Parse the package headers the file at FILE-NAME.
 355
 356 Return an `epl-package' object with the header metadata."
 357   (with-temp-buffer
 358     (insert-file-contents file-name)
 359     (condition-case err
 360         (epl-package-from-buffer (current-buffer))
 361       ;; Attach file names to invalid package errors
 362       (epl-invalid-package
 363        (signal 'epl-invalid-package-file (cons file-name (cdr err))))
 364       ;; Forward other errors
 365       (error (signal (car err) (cdr err))))))
 366
 367 (defun epl-package-from-tar-file (file-name)
 368   "Parse the package tarball at FILE-NAME.
 369
 370 Return a `epl-package' object with the meta data of the tarball
 371 package in FILE-NAME."
 372   (condition-case nil
 373       ;; In legacy package.el, `package-tar-file-info' takes the name of the tar
 374       ;; file to parse as argument.  In modern package.el, it has no arguments
 375       ;; and works on the current buffer.  Hence, we just try to call the legacy
 376       ;; version, and if that fails because of a mismatch between formal and
 377       ;; actual arguments, we use the modern approach.  To avoid spurious
 378       ;; signature warnings by the byte compiler, we suppress warnings when
 379       ;; calling the function.
 380       (epl-package--parse-info (with-no-warnings
 381                                  (package-tar-file-info file-name)))
 382     (wrong-number-of-arguments
 383      (with-temp-buffer
 384        (insert-file-contents-literally file-name)
 385        ;; Switch to `tar-mode' to enable extraction of the file.  Modern
 386        ;; `package-tar-file-info' relies on `tar-mode', and signals an error if
 387        ;; called in a buffer with a different mode.
 388        (tar-mode)
 389        (epl-package--parse-info (with-no-warnings
 390                                   (package-tar-file-info)))))))
 391
 392 (defun epl-package-from-file (file-name)
 393   "Parse the package at FILE-NAME.
 394
 395 Return an `epl-package' object with the meta data of the package
 396 at FILE-NAME."
 397   (if (string-match-p (rx ".tar" string-end) file-name)
 398       (epl-package-from-tar-file file-name)
 399     (epl-package-from-lisp-file file-name)))
 400
 401 (defun epl-package--parse-descriptor-requirement (requirement)
 402   "Parse a REQUIREMENT in a package descriptor."
 403   ;; This function is only called on legacy package.el.  On package-desc
 404   ;; package.el, we just let package.el do the work.
 405   (cl-destructuring-bind (name version-string) requirement
 406     (list name (version-to-list version-string))))
 407
 408 (defun epl-package-from-descriptor-file (descriptor-file)
 409   "Load a `epl-package' from a package DESCRIPTOR-FILE.
 410
 411 A package descriptor is a file defining a new package.  Its name
 412 typically ends with -pkg.el."
 413   (with-temp-buffer
 414     (insert-file-contents descriptor-file)
 415     (goto-char (point-min))
 416     (let ((sexp (read (current-buffer))))
 417       (unless (eq (car sexp) 'define-package)
 418         (error "%S is no valid package descriptor" descriptor-file))
 419       (if (and (fboundp 'package-desc-from-define)
 420                (fboundp 'package-desc-name))
 421           ;; In Emacs snapshot, we can conveniently call a function to parse the
 422           ;; descriptor
 423           (let ((desc (apply #'package-desc-from-define (cdr sexp))))
 424             (epl-package-create :name (package-desc-name desc)
 425                                 :description desc))
 426         ;; In legacy package.el, we must manually deconstruct the descriptor,
 427         ;; because the load function has eval's the descriptor and has a lot of
 428         ;; global side-effects.
 429         (cl-destructuring-bind
 430             (name version-string summary requirements) (cdr sexp)
 431           (epl-package-create
 432            :name (intern name)
 433            :description
 434            (vector (version-to-list version-string)
 435                    (mapcar #'epl-package--parse-descriptor-requirement
 436                            ;; Strip the leading `quote' from the package list
 437                            (cadr requirements))
 438                    summary)))))))
 439
 440 \f
 441 ;;; Package database access
 442 (defun epl-package-installed-p (package &optional min-version)
 443   "Determine whether a PACKAGE, of MIN-VERSION or newer, is installed.
 444
 445 PACKAGE is either a package name as symbol, or a package object.
 446 When a explicit MIN-VERSION is provided it overwrites the version of the PACKAGE object."
 447   (let ((name (if (epl-package-p package)
 448                   (epl-package-name package)
 449                 package))
 450         (min-version (or min-version (and (epl-package-p package)
 451                                           (epl-package-version package)))))
 452     (package-installed-p name min-version)))
 453
 454 (defun epl--parse-built-in-entry (entry)
 455   "Parse an ENTRY from the list of built-in packages.
 456
 457 Return the corresponding `epl-package' object."
 458   (if (fboundp 'package--from-builtin)
 459       ;; In package-desc package.el, convert the built-in package to a
 460       ;; `package-desc' and convert that to an `epl-package'
 461       (epl-package--from-package-desc (package--from-builtin entry))
 462     (epl-package-create :name (car entry) :description (cdr entry))))
 463
 464 (defun epl-built-in-packages ()
 465   "Get all built-in packages.
 466
 467 Return a list of `epl-package' objects."
 468   ;; This looks mighty strange, but it's the only way to force package.el to
 469   ;; build the list of built-in packages.  Without this, `package--builtins'
 470   ;; might be empty.
 471   (package-built-in-p 'foo)
 472   (mapcar #'epl--parse-built-in-entry package--builtins))
 473
 474 (defun epl-find-built-in-package (name)
 475   "Find a built-in package with NAME.
 476
 477 NAME is a package name, as symbol.
 478
 479 Return the built-in package as `epl-package' object, or nil if
 480 there is no built-in package with NAME."
 481   (when (package-built-in-p name)
 482     ;; We must call `package-built-in-p' *before* inspecting
 483     ;; `package--builtins', because otherwise `package--builtins' might be
 484     ;; empty.
 485     (epl--parse-built-in-entry (assq name package--builtins))))
 486
 487 (defun epl-package-outdated-p (package)
 488   "Determine whether a PACKAGE is outdated.
 489
 490 A package is outdated, if there is an available package with a
 491 higher version.
 492
 493 PACKAGE is either a package name as symbol, or a package object.
 494 In the former case, test the installed or built-in package with
 495 the highest version number, in the later case, test the package
 496 object itself.
 497
 498 Return t, if the package is outdated, or nil otherwise."
 499   (let* ((package (if (epl-package-p package)
 500                       package
 501                     (or (car (epl-find-installed-packages package))
 502                         (epl-find-built-in-package package))))
 503          (available (car (epl-find-available-packages
 504                           (epl-package-name package)))))
 505     (and package available (version-list-< (epl-package-version package)
 506                                            (epl-package-version available)))))
 507
 508 (defun epl--parse-package-list-entry (entry)
 509   "Parse a list of packages from ENTRY.
 510
 511 ENTRY is a single entry in a package list, e.g. `package-alist',
 512 `package-archive-contents', etc.  Typically it is a cons cell,
 513 but the exact format varies between package.el versions.  This
 514 function tries to parse all known variants.
 515
 516 Return a list of `epl-package' objects parsed from ENTRY."
 517   (let ((descriptions (cdr entry)))
 518     (cond
 519      ((listp descriptions)
 520       (sort (mapcar #'epl-package--from-package-desc descriptions)
 521             #'epl-package-->=))
 522      ;; Legacy package.el has just a single package in an entry, which is a
 523      ;; standard description vector
 524      ((vectorp descriptions)
 525       (list (epl-package-create :name (car entry)
 526                                 :description descriptions)))
 527      (:else (error "Cannot parse entry %S" entry)))))
 528
 529 (defun epl-installed-packages ()
 530   "Get all installed packages.
 531
 532 Return a list of package objects."
 533   (apply #'append (mapcar #'epl--parse-package-list-entry package-alist)))
 534
 535 (defsubst epl--filter-outdated-packages (packages)
 536   "Filter outdated packages from PACKAGES."
 537   (let (res)
 538     (dolist (package packages)
 539       (when (epl-package-outdated-p package)
 540         (push package res)))
 541     (nreverse res)))
 542
 543 (defun epl-outdated-packages ()
 544   "Get all outdated packages, as in `epl-package-outdated-p'.
 545
 546 Return a list of package objects."
 547   (epl--filter-outdated-packages (epl-installed-packages)))
 548
 549 (defsubst epl--find-package-in-list (name list)
 550   "Find a package by NAME in a package LIST.
 551
 552 Return a list of corresponding `epl-package' objects."
 553   (let ((entry (assq name list)))
 554     (when entry
 555       (epl--parse-package-list-entry entry))))
 556
 557 (defun epl-find-installed-package (name)
 558   "Find the latest installed package by NAME.
 559
 560 NAME is a package name, as symbol.
 561
 562 Return the installed package with the highest version number as
 563 `epl-package' object, or nil, if no package with NAME is
 564 installed."
 565   (car (epl-find-installed-packages name)))
 566 (make-obsolete 'epl-find-installed-package 'epl-find-installed-packages "0.7")
 567
 568 (defun epl-find-installed-packages (name)
 569   "Find all installed packages by NAME.
 570
 571 NAME is a package name, as symbol.
 572
 573 Return a list of all installed packages with NAME, sorted by
 574 version number in descending order.  Return nil, if there are no
 575 packages with NAME."
 576   (epl--find-package-in-list name package-alist))
 577
 578 (defun epl-available-packages ()
 579   "Get all packages available for installation.
 580
 581 Return a list of package objects."
 582   (apply #'append (mapcar #'epl--parse-package-list-entry
 583                           package-archive-contents)))
 584
 585 (defun epl-find-available-packages (name)
 586   "Find available packages for NAME.
 587
 588 NAME is a package name, as symbol.
 589
 590 Return a list of available packages for NAME, sorted by version
 591 number in descending order.  Return nil, if there are no packages
 592 for NAME."
 593   (epl--find-package-in-list name package-archive-contents))
 594
 595 (cl-defstruct (epl-upgrade
 596                (:constructor epl-upgrade-create))
 597   "Structure describing an upgradable package.
 598 Slots:
 599
 600 `installed' The installed package
 601
 602 `available' The package available for installation."
 603   installed
 604   available)
 605
 606 (defun epl-find-upgrades (&optional packages)
 607   "Find all upgradable PACKAGES.
 608
 609 PACKAGES is a list of package objects to upgrade, defaulting to
 610 all installed packages.
 611
 612 Return a list of `epl-upgrade' objects describing all upgradable
 613 packages."
 614   (let ((packages (or packages (epl-installed-packages)))
 615         upgrades)
 616     (dolist (pkg packages)
 617       (let* ((version (epl-package-version pkg))
 618              (name (epl-package-name pkg))
 619              ;; Find the latest available package for NAME
 620              (available-pkg (car (epl-find-available-packages name)))
 621              (available-version (when available-pkg
 622                                   (epl-package-version available-pkg))))
 623         (when (and available-version (version-list-< version available-version))
 624           (push (epl-upgrade-create :installed pkg
 625                                     :available available-pkg)
 626                 upgrades))))
 627     (nreverse upgrades)))
 628
 629 (defalias 'epl-built-in-p 'package-built-in-p)
 630
 631 \f
 632 ;;; Package operations
 633
 634 (defun epl-install-file (file)
 635     "Install a package from FILE, like `package-install-file'."
 636     (interactive (advice-eval-interactive-spec
 637                   (cadr (interactive-form #'package-install-file))))
 638     (apply #'package-install-file (list file))
 639     (let ((package (epl-package-from-file file)))
 640       (unless (epl-package--package-desc-p package)
 641         (epl--kill-autoload-buffer package))))
 642
 643 (defun epl--kill-autoload-buffer (package)
 644   "Kill the buffer associated with autoloads for PACKAGE."
 645   (let* ((auto-name (format "%s-autoloads.el" (epl-package-name package)))
 646          (generated-autoload-file (expand-file-name auto-name (epl-package-directory package)))
 647          (buf (find-buffer-visiting generated-autoload-file)))
 648     (when buf (kill-buffer buf))))
 649
 650 (defun epl-package-install (package &optional force)
 651   "Install a PACKAGE.
 652
 653 PACKAGE is a `epl-package' object.  If FORCE is given and
 654 non-nil, install PACKAGE, even if it is already installed."
 655   (when (or force (not (epl-package-installed-p package)))
 656     (if (epl-package--package-desc-p package)
 657         (package-install (epl-package-description package))
 658       ;; The legacy API installs by name.  We have no control over versioning,
 659       ;; etc.
 660       (package-install (epl-package-name package))
 661       (epl--kill-autoload-buffer package))))
 662
 663 (defun epl-package-delete (package)
 664   "Delete a PACKAGE.
 665
 666 PACKAGE is a `epl-package' object to delete."
 667   ;; package-delete allows for packages being trashed instead of fully deleted.
 668   ;; Let's prevent his silly behavior
 669   (let ((delete-by-moving-to-trash nil))
 670     ;; The byte compiler will warn us that we are calling `package-delete' with
 671     ;; the wrong number of arguments, since it can't infer that we guarantee to
 672     ;; always call the correct version.  Thus we suppress all warnings when
 673     ;; calling `package-delete'.  I wish there was a more granular way to
 674     ;; disable just that specific warning, but it is what it is.
 675     (if (epl-package--package-desc-p package)
 676         (with-no-warnings
 677           (package-delete (epl-package-description package)))
 678       ;; The legacy API deletes by name (as string!) and version instead by
 679       ;; descriptor.  Hence `package-delete' takes two arguments.  For some
 680       ;; insane reason, the arguments are strings here!
 681       (let ((name (symbol-name (epl-package-name package)))
 682             (version (epl-package-version-string package)))
 683         (with-no-warnings
 684           (package-delete name version))
 685         ;; Legacy package.el does not remove the deleted package
 686         ;; from the `package-alist', so we do it manually here.
 687         (let ((pkg (assq (epl-package-name package) package-alist)))
 688           (when pkg
 689             (setq package-alist (delq pkg package-alist))))))))
 690
 691 (defun epl-upgrade (&optional packages preserve-obsolete)
 692   "Upgrade PACKAGES.
 693
 694 PACKAGES is a list of package objects to upgrade, defaulting to
 695 all installed packages.
 696
 697 The old versions of the updated packages are deleted, unless
 698 PRESERVE-OBSOLETE is non-nil.
 699
 700 Return a list of all performed upgrades, as a list of
 701 `epl-upgrade' objects."
 702   (let ((upgrades (epl-find-upgrades packages)))
 703     (dolist (upgrade upgrades)
 704       (epl-package-install (epl-upgrade-available upgrade) 'force)
 705       (unless preserve-obsolete
 706         (epl-package-delete (epl-upgrade-installed upgrade))))
 707     upgrades))
 708
 709 (provide 'epl)
 710
 711 ;;; epl.el ends here