mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-18 9d27fc972e84736015ab3b1c331888a8fe3d1276
commit | author | age
5cb5f7 1 ;;; epl.el --- Emacs Package Library -*- lexical-binding: t; -*-
C 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
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
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
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
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
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
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
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