1 ;;; epl.el --- Emacs Package Library -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2013-2015 Sebastian Wiesner
4 ;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2015 Free Software
6 ;; Author: Sebastian Wiesner <swiesner@lunaryorn.com>
7 ;; Maintainer: Johan Andersson <johan.rejeep@gmail.com>
8 ;; Sebastian Wiesner <swiesner@lunaryorn.com>
10 ;; Package-Version: 20180205.2049
11 ;; Package-Requires: ((cl-lib "0.3"))
12 ;; Keywords: convenience
13 ;; URL: http://github.com/cask/epl
15 ;; This file is NOT part of GNU Emacs.
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.
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.
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/>.
32 ;; A package management library for Emacs, based on package.el.
34 ;; The purpose of this library is to wrap all the quirks and hassle of
35 ;; package.el into a sane API.
37 ;; The following functions comprise the public interface of this library:
39 ;;; Package directory selection
41 ;; `epl-package-dir' gets the directory of packages.
43 ;; `epl-default-package-dir' gets the default package directory.
45 ;; `epl-change-package-dir' changes the directory of packages.
47 ;;; Package system management
49 ;; `epl-initialize' initializes the package system and activates all
52 ;; `epl-reset' resets the package system.
54 ;; `epl-refresh' refreshes all package archives.
56 ;; `epl-add-archive' adds a new package archive.
60 ;; Struct `epl-requirement' describes a requirement of a package with `name' and
63 ;; `epl-requirement-version-string' gets a requirement version as string.
65 ;; Struct `epl-package' describes an installed or installable package with a
66 ;; `name' and some internal `description'.
68 ;; `epl-package-version' gets the version of a package.
70 ;; `epl-package-version-string' gets the version of a package as string.
72 ;; `epl-package-summary' gets the summary of a package.
74 ;; `epl-package-requirements' gets the requirements of a package.
76 ;; `epl-package-directory' gets the installation directory of a package.
78 ;; `epl-package-from-buffer' creates a package object for the package contained
79 ;; in the current buffer.
81 ;; `epl-package-from-file' creates a package object for a package file, either
82 ;; plain lisp or tarball.
84 ;; `epl-package-from-descriptor-file' creates a package object for a package
85 ;; description (i.e. *-pkg.el) file.
87 ;;; Package database access
89 ;; `epl-package-installed-p' determines whether a package is installed, either
90 ;; built-in or explicitly installed.
92 ;; `epl-package-outdated-p' determines whether a package is outdated, that is,
93 ;; whether a package with a higher version number is available.
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.
99 ;; `epl-find-built-in-package', `epl-find-installed-packages' and
100 ;; `epl-find-available-packages' find built-in, installed and available packages
103 ;; `epl-find-upgrades' finds all upgradable packages.
105 ;; `epl-built-in-p' return true if package is built-in to Emacs.
107 ;;; Package operations
109 ;; `epl-install-file' installs a package file.
111 ;; `epl-package-install' installs a package.
113 ;; `epl-package-delete' deletes a package.
115 ;; `epl-upgrade' upgrades packages.
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))
135 (mapcar (lambda (parent)
137 (or (get parent 'error-conditions)
138 (error "Unknown signal `%s'" 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)))))
145 (defsubst epl--package-desc-p (package)
146 "Whether PACKAGE is a `package-desc' object.
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)))
154 (define-error 'epl-error "EPL error")
156 (define-error 'epl-invalid-package "Invalid EPL package" 'epl-error)
158 (define-error 'epl-invalid-package-file "Invalid EPL package file"
159 'epl-invalid-package)
162 ;;; Package directory
163 (defun epl-package-dir ()
164 "Get the directory of packages."
167 (defun epl-default-package-dir ()
168 "Get the default directory of packages."
169 (eval (car (get 'package-user-dir 'standard-value))))
171 (defun epl-change-package-dir (directory)
172 "Change the directory of packages to DIRECTORY."
173 (setq package-user-dir directory)
177 ;;; Package system management
178 (defvar epl--load-path-before-initialize nil
179 "Remember the load path for `epl-reset'.")
181 (defun epl-initialize (&optional no-activate)
182 "Load Emacs Lisp packages and activate them.
184 With NO-ACTIVATE non-nil, do not activate packages."
185 (setq epl--load-path-before-initialize load-path)
186 (package-initialize no-activate))
188 (defalias 'epl-refresh 'package-refresh-contents)
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)))
195 "Reset the package system.
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
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)))
208 ;;; Package structures
209 (cl-defstruct (epl-requirement
210 (:constructor epl-requirement-create))
211 "Structure describing a requirement.
215 `name' The name of the required package, as symbol.
217 `version' The version of the required package, as version list."
221 (defun epl-requirement-version-string (requirement)
222 "The version of a REQUIREMENT, as string."
223 (package-version-join (epl-requirement-version requirement)))
225 (cl-defstruct (epl-package (:constructor epl-package-create))
226 "Structure representing a package.
230 `name' The package name, as symbol.
232 `description' The package description.
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]'.
239 Do not access `description' directly, but instead use the
240 `epl-package' accessors."
244 (defmacro epl-package-as-description (var &rest body)
245 "Cast VAR to a package description in BODY.
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."
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)))
256 (signal 'wrong-type-argument (list #'epl-package-p ,var))))
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)))
262 (defun epl-package-version (package)
263 "Get the version of PACKAGE, as version list."
264 (epl-package-as-description package
266 ((fboundp 'package-desc-version) (package-desc-version package))
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)))))
273 (defun epl-package-version-string (package)
274 "Get the version from a PACKAGE, as string."
275 (package-version-join (epl-package-version package)))
277 (defun epl-package-summary (package)
278 "Get the summary of PACKAGE, as string."
279 (epl-package-as-description package
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)))))
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)))))
292 (defun epl-package-requirements (package)
293 "Get the requirements of PACKAGE.
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))))
299 (defun epl-package-directory (package)
300 "Get the directory PACKAGE is installed to.
302 Return the absolute path of the installation directory of
303 PACKAGE, or nil, if PACKAGE is not installed."
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))))
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))))
317 (defun epl-package--from-package-desc (package-desc)
318 "Create an `epl-package' from a PACKAGE-DESC.
320 PACKAGE-DESC is a `package-desc' object, from recent package.el
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))))
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))))
340 (defun epl-package-from-buffer (&optional buffer)
341 "Create an `epl-package' object from BUFFER.
343 BUFFER defaults to the current buffer.
345 Signal `epl-invalid-package' if the buffer does not contain a
347 (let ((info (with-current-buffer (or buffer (current-buffer))
349 (package-buffer-info)
350 (error (signal 'epl-invalid-package (cdr err)))))))
351 (epl-package--parse-info info)))
353 (defun epl-package-from-lisp-file (file-name)
354 "Parse the package headers the file at FILE-NAME.
356 Return an `epl-package' object with the header metadata."
358 (insert-file-contents file-name)
360 (epl-package-from-buffer (current-buffer))
361 ;; Attach file names to invalid package errors
363 (signal 'epl-invalid-package-file (cons file-name (cdr err))))
364 ;; Forward other errors
365 (error (signal (car err) (cdr err))))))
367 (defun epl-package-from-tar-file (file-name)
368 "Parse the package tarball at FILE-NAME.
370 Return a `epl-package' object with the meta data of the tarball
371 package in FILE-NAME."
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
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.
389 (epl-package--parse-info (with-no-warnings
390 (package-tar-file-info)))))))
392 (defun epl-package-from-file (file-name)
393 "Parse the package at FILE-NAME.
395 Return an `epl-package' object with the meta data of the package
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)))
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))))
408 (defun epl-package-from-descriptor-file (descriptor-file)
409 "Load a `epl-package' from a package DESCRIPTOR-FILE.
411 A package descriptor is a file defining a new package. Its name
412 typically ends with -pkg.el."
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
423 (let ((desc (apply #'package-desc-from-define (cdr sexp))))
424 (epl-package-create :name (package-desc-name 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)
434 (vector (version-to-list version-string)
435 (mapcar #'epl-package--parse-descriptor-requirement
436 ;; Strip the leading `quote' from the package list
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.
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)
450 (min-version (or min-version (and (epl-package-p package)
451 (epl-package-version package)))))
452 (package-installed-p name min-version)))
454 (defun epl--parse-built-in-entry (entry)
455 "Parse an ENTRY from the list of built-in packages.
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))))
464 (defun epl-built-in-packages ()
465 "Get all built-in packages.
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'
471 (package-built-in-p 'foo)
472 (mapcar #'epl--parse-built-in-entry package--builtins))
474 (defun epl-find-built-in-package (name)
475 "Find a built-in package with NAME.
477 NAME is a package name, as symbol.
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
485 (epl--parse-built-in-entry (assq name package--builtins))))
487 (defun epl-package-outdated-p (package)
488 "Determine whether a PACKAGE is outdated.
490 A package is outdated, if there is an available package with a
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
498 Return t, if the package is outdated, or nil otherwise."
499 (let* ((package (if (epl-package-p 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)))))
508 (defun epl--parse-package-list-entry (entry)
509 "Parse a list of packages from ENTRY.
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.
516 Return a list of `epl-package' objects parsed from ENTRY."
517 (let ((descriptions (cdr entry)))
519 ((listp descriptions)
520 (sort (mapcar #'epl-package--from-package-desc descriptions)
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)))))
529 (defun epl-installed-packages ()
530 "Get all installed packages.
532 Return a list of package objects."
533 (apply #'append (mapcar #'epl--parse-package-list-entry package-alist)))
535 (defsubst epl--filter-outdated-packages (packages)
536 "Filter outdated packages from PACKAGES."
538 (dolist (package packages)
539 (when (epl-package-outdated-p package)
543 (defun epl-outdated-packages ()
544 "Get all outdated packages, as in `epl-package-outdated-p'.
546 Return a list of package objects."
547 (epl--filter-outdated-packages (epl-installed-packages)))
549 (defsubst epl--find-package-in-list (name list)
550 "Find a package by NAME in a package LIST.
552 Return a list of corresponding `epl-package' objects."
553 (let ((entry (assq name list)))
555 (epl--parse-package-list-entry entry))))
557 (defun epl-find-installed-package (name)
558 "Find the latest installed package by NAME.
560 NAME is a package name, as symbol.
562 Return the installed package with the highest version number as
563 `epl-package' object, or nil, if no package with NAME is
565 (car (epl-find-installed-packages name)))
566 (make-obsolete 'epl-find-installed-package 'epl-find-installed-packages "0.7")
568 (defun epl-find-installed-packages (name)
569 "Find all installed packages by NAME.
571 NAME is a package name, as symbol.
573 Return a list of all installed packages with NAME, sorted by
574 version number in descending order. Return nil, if there are no
576 (epl--find-package-in-list name package-alist))
578 (defun epl-available-packages ()
579 "Get all packages available for installation.
581 Return a list of package objects."
582 (apply #'append (mapcar #'epl--parse-package-list-entry
583 package-archive-contents)))
585 (defun epl-find-available-packages (name)
586 "Find available packages for NAME.
588 NAME is a package name, as symbol.
590 Return a list of available packages for NAME, sorted by version
591 number in descending order. Return nil, if there are no packages
593 (epl--find-package-in-list name package-archive-contents))
595 (cl-defstruct (epl-upgrade
596 (:constructor epl-upgrade-create))
597 "Structure describing an upgradable package.
600 `installed' The installed package
602 `available' The package available for installation."
606 (defun epl-find-upgrades (&optional packages)
607 "Find all upgradable PACKAGES.
609 PACKAGES is a list of package objects to upgrade, defaulting to
610 all installed packages.
612 Return a list of `epl-upgrade' objects describing all upgradable
614 (let ((packages (or packages (epl-installed-packages)))
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)
627 (nreverse upgrades)))
629 (defalias 'epl-built-in-p 'package-built-in-p)
632 ;;; Package operations
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))))
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))))
650 (defun epl-package-install (package &optional force)
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,
660 (package-install (epl-package-name package))
661 (epl--kill-autoload-buffer package))))
663 (defun epl-package-delete (package)
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)
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)))
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)))
689 (setq package-alist (delq pkg package-alist))))))))
691 (defun epl-upgrade (&optional packages preserve-obsolete)
694 PACKAGES is a list of package objects to upgrade, defaulting to
695 all installed packages.
697 The old versions of the updated packages are deleted, unless
698 PRESERVE-OBSOLETE is non-nil.
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))))