1 ;;; pkg-info.el --- Information about packages -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2013-2015 Sebastian Wiesner <swiesner@lunaryorn.com>
5 ;; Author: Sebastian Wiesner <swiesner@lunaryorn.com>
6 ;; URL: https://github.com/lunaryorn/pkg-info.el
7 ;; Package-Version: 20150517.1143
8 ;; Keywords: convenience
10 ;; Package-Requires: ((epl "0.8"))
12 ;; This file is not part of GNU Emacs.
14 ;; This program is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
19 ;; This program is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
29 ;; This library extracts information from installed packages.
33 ;; `pkg-info-library-version' extracts the version from the header of a library.
35 ;; `pkg-info-defining-library-version' extracts the version from the header of a
36 ;; library defining a function.
38 ;; `pkg-info-package-version' gets the version of an installed package.
40 ;; `pkg-info-format-version' formats a version list as human readable string.
42 ;; `pkg-info-version-info' returns complete version information for a specific
45 ;; `pkg-info-get-melpa-recipe' gets the MELPA recipe for a package.
47 ;; `pkg-info-get-melpa-fetcher' gets the fetcher used to build a package on
50 ;; `pkg-info-wiki-package-p' determines whether a package was build from
51 ;; EmacsWiki on MELPA.
59 (require 'json) ; `json-read'
60 (require 'url-http) ; `url-http-parse-response'
62 (defvar url-http-end-of-headers)
65 ;;; Version information
66 (defun pkg-info-format-version (version)
67 "Format VERSION as human-readable string.
69 Return a human-readable string representing VERSION."
70 ;; XXX: Find a better, more flexible way of formatting?
71 (package-version-join version))
73 (defsubst pkg-info--show-version-and-return (version show)
74 "Show and return VERSION.
76 When SHOW is non-nil, show VERSION in minibuffer.
80 (message (if (listp version) (pkg-info-format-version version) version)))
83 (defun pkg-info--read-library ()
84 "Read a library from minibuffer."
85 (completing-read "Load library: "
86 (apply-partially 'locate-file-completion-table
88 (get-load-suffixes))))
90 (defun pkg-info--read-function ()
91 "Read a function name from minibuffer."
92 (let ((input (completing-read "Function: " obarray #'boundp :require-match)))
93 (if (string= input "") nil (intern input))))
95 (defun pkg-info--read-package ()
96 "Read a package name from minibuffer."
97 (let* ((installed (epl-installed-packages))
98 (names (sort (mapcar (lambda (pkg)
99 (symbol-name (epl-package-name pkg)))
102 (default (car names)))
103 (completing-read "Installed package: " names nil 'require-match
106 (defun pkg-info-library-source (library)
107 "Get the source file of LIBRARY.
109 LIBRARY is either a symbol denoting a named feature, or a library
112 Return the source file of LIBRARY as string."
113 (find-library-name (if (symbolp library) (symbol-name library) library)))
115 (defun pkg-info-defining-library (function)
116 "Get the source file of the library defining FUNCTION.
118 FUNCTION is a function symbol.
120 Return the file name of the library as string. Signal an error
121 if the library does not exist, or if the definition of FUNCTION
123 (unless (functionp function)
124 (signal 'wrong-type-argument (list 'functionp function)))
125 (let ((library (symbol-file function 'defun)))
127 (error "Can't find definition of %s" function))
130 (defun pkg-info-x-original-version (file)
131 "Read the X-Original-Version header from FILE.
133 Return the value as version list, or return nil if FILE lacks
134 this header. Signal an error, if the value of the header is not
136 (let ((version-str (with-temp-buffer
137 (insert-file-contents file)
138 (lm-header "X-Original-Version"))))
140 (version-to-list version-str))))
143 (defun pkg-info-library-original-version (library &optional show)
144 "Get the original version in the header of LIBRARY.
146 The original version is stored in the X-Original-Version header.
147 This header is added by the MELPA package archive to preserve
148 upstream version numbers.
150 LIBRARY is either a symbol denoting a named feature, or a library
153 If SHOW is non-nil, show the version in the minibuffer.
155 Return the version from the header of LIBRARY as list. Signal an
156 error if the LIBRARY was not found or had no X-Original-Version
159 See Info node `(elisp)Library Headers' for more information
160 about library headers."
161 (interactive (list (pkg-info--read-library) t))
162 (let ((version (pkg-info-x-original-version
163 (pkg-info-library-source library))))
165 (pkg-info--show-version-and-return version show)
166 (error "Library %s has no original version" library))))
169 (defun pkg-info-library-version (library &optional show)
170 "Get the version in the header of LIBRARY.
172 LIBRARY is either a symbol denoting a named feature, or a library
175 If SHOW is non-nil, show the version in the minibuffer.
177 Return the version from the header of LIBRARY as list. Signal an
178 error if the LIBRARY was not found or had no proper header.
180 See Info node `(elisp)Library Headers' for more information
181 about library headers."
182 (interactive (list (pkg-info--read-library) t))
183 (let* ((source (pkg-info-library-source library))
184 (version (epl-package-version (epl-package-from-file source))))
185 (pkg-info--show-version-and-return version show)))
188 (defun pkg-info-defining-library-original-version (function &optional show)
189 "Get the original version of the library defining FUNCTION.
191 The original version is stored in the X-Original-Version header.
192 This header is added by the MELPA package archive to preserve
193 upstream version numbers.
195 If SHOW is non-nil, show the version in mini-buffer.
197 This function is mainly intended to find the version of a major
200 (pkg-info-defining-library-version 'flycheck-mode)
202 Return the version of the library defining FUNCTION. Signal an
203 error if FUNCTION is not a valid function, if its defining
204 library was not found, or if the library had no proper version
206 (interactive (list (pkg-info--read-function) t))
207 (pkg-info-library-original-version (pkg-info-defining-library function) show))
210 (defun pkg-info-defining-library-version (function &optional show)
211 "Get the version of the library defining FUNCTION.
213 If SHOW is non-nil, show the version in mini-buffer.
215 This function is mainly intended to find the version of a major
218 (pkg-info-defining-library-version 'flycheck-mode)
220 Return the version of the library defining FUNCTION. Signal an
221 error if FUNCTION is not a valid function, if its defining
222 library was not found, or if the library had no proper version
224 (interactive (list (pkg-info--read-function) t))
225 (pkg-info-library-version (pkg-info-defining-library function) show))
228 (defun pkg-info-package-version (package &optional show)
229 "Get the version of an installed PACKAGE.
231 If SHOW is non-nil, show the version in the minibuffer.
233 Return the version as list, or nil if PACKAGE is not installed."
234 (interactive (list (pkg-info--read-package) t))
235 (let* ((name (if (stringp package) (intern package) package))
236 (package (car (epl-find-installed-packages name))))
238 (error "Can't find installed package %s" name))
239 (pkg-info--show-version-and-return (epl-package-version package) show)))
242 (defun pkg-info-version-info (library &optional package show)
243 "Obtain complete version info for LIBRARY and PACKAGE.
245 LIBRARY is a symbol denoting a named feature, or a library name
246 as string. PACKAGE is a symbol denoting an ELPA package. If
247 omitted or nil, default to LIBRARY.
249 If SHOW is non-nil, show the version in the minibuffer.
251 When called interactively, prompt for LIBRARY. When called
252 interactively with prefix argument, prompt for PACKAGE as well.
254 Return a string with complete version information for LIBRARY.
255 This version information contains the version from the headers of
256 LIBRARY, and the version of the installed PACKAGE, the LIBRARY is
257 part of. If PACKAGE is not installed, or if the PACKAGE version
258 is the same as the LIBRARY version, do not include a package
260 (interactive (list (pkg-info--read-library)
261 (when current-prefix-arg
262 (pkg-info--read-package))
264 (let* ((package (or package (if (stringp library) (intern library) library)))
265 (orig-version (condition-case nil
266 (pkg-info-library-original-version library)
268 ;; If we have X-Original-Version, we assume that MELPA replaced the
269 ;; library version with its generated version, so we use the
270 ;; X-Original-Version header instead, and ignore the library version
272 (lib-version (or orig-version (pkg-info-library-version library)))
273 (pkg-version (condition-case nil
274 (pkg-info-package-version package)
276 (version (if (and pkg-version
277 (not (version-list-= lib-version pkg-version)))
278 (format "%s (package: %s)"
279 (pkg-info-format-version lib-version)
280 (pkg-info-format-version pkg-version))
281 (pkg-info-format-version lib-version))))
282 (pkg-info--show-version-and-return version show)))
284 (defconst pkg-info-melpa-recipe-url "http://melpa.org/recipes.json"
285 "The URL from which to fetch MELPA recipes.")
287 (defvar pkg-info-melpa-recipes nil
288 "An alist of MELPA recipes.")
290 (defun pkg-info-retrieve-melpa-recipes ()
291 "Retrieve MELPA recipes from MELPA archive."
292 (let ((buffer (url-retrieve-synchronously pkg-info-melpa-recipe-url)))
293 (with-current-buffer buffer
295 (let ((response-code (url-http-parse-response)))
296 (unless (equal response-code 200)
297 (error "Failed to retrieve MELPA recipes from %s (code %s)"
298 pkg-info-melpa-recipe-url response-code))
299 (goto-char url-http-end-of-headers)
301 (when (and buffer (buffer-live-p buffer))
302 (kill-buffer buffer))))))
304 (defun pkg-info-get-melpa-recipes ()
306 (setq pkg-info-melpa-recipes
307 (or pkg-info-melpa-recipes
308 (pkg-info-retrieve-melpa-recipes))))
310 (defun pkg-info-get-melpa-recipe (package)
311 "Get the MELPA recipe for PACKAGE.
313 Return nil if PACKAGE is not on MELPA."
314 (cdr (assq package (pkg-info-get-melpa-recipes))))
316 (defun pkg-info-get-melpa-fetcher (package)
317 "Get the MELPA fetcher for PACKAGE."
318 (cdr (assq 'fetcher (pkg-info-get-melpa-recipe package))))
320 (defun pkg-info-wiki-package-p (package)
321 "Determine whether PACKAGE is build from the EmacsWiki."
322 (equal (pkg-info-get-melpa-fetcher package) "wiki"))
327 ;; indent-tabs-mode: nil
331 ;;; pkg-info.el ends here