Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

711 rivejä
26 KiB

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