1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
|
;;; pkg-info.el --- Information about packages -*- lexical-binding: t; -*-
;; Copyright (C) 2013-2015 Sebastian Wiesner <swiesner@lunaryorn.com>
;; Author: Sebastian Wiesner <swiesner@lunaryorn.com>
;; URL: https://github.com/lunaryorn/pkg-info.el
;; Package-Version: 20150517.1143
;; Keywords: convenience
;; Version: 0.7-cvs
;; Package-Requires: ((epl "0.8"))
;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This library extracts information from installed packages.
;;;; Functions:
;; `pkg-info-library-version' extracts the version from the header of a library.
;;
;; `pkg-info-defining-library-version' extracts the version from the header of a
;; library defining a function.
;;
;; `pkg-info-package-version' gets the version of an installed package.
;;
;; `pkg-info-format-version' formats a version list as human readable string.
;;
;; `pkg-info-version-info' returns complete version information for a specific
;; package.
;;
;; `pkg-info-get-melpa-recipe' gets the MELPA recipe for a package.
;;
;; `pkg-info-get-melpa-fetcher' gets the fetcher used to build a package on
;; MELPA.
;;
;; `pkg-info-wiki-package-p' determines whether a package was build from
;; EmacsWiki on MELPA.
;;; Code:
(require 'epl)
(require 'lisp-mnt)
(require 'find-func)
(require 'json) ; `json-read'
(require 'url-http) ; `url-http-parse-response'
(defvar url-http-end-of-headers)
;;; Version information
(defun pkg-info-format-version (version)
"Format VERSION as human-readable string.
Return a human-readable string representing VERSION."
;; XXX: Find a better, more flexible way of formatting?
(package-version-join version))
(defsubst pkg-info--show-version-and-return (version show)
"Show and return VERSION.
When SHOW is non-nil, show VERSION in minibuffer.
Return VERSION."
(when show
(message (if (listp version) (pkg-info-format-version version) version)))
version)
(defun pkg-info--read-library ()
"Read a library from minibuffer."
(completing-read "Load library: "
(apply-partially 'locate-file-completion-table
load-path
(get-load-suffixes))))
(defun pkg-info--read-function ()
"Read a function name from minibuffer."
(let ((input (completing-read "Function: " obarray #'boundp :require-match)))
(if (string= input "") nil (intern input))))
(defun pkg-info--read-package ()
"Read a package name from minibuffer."
(let* ((installed (epl-installed-packages))
(names (sort (mapcar (lambda (pkg)
(symbol-name (epl-package-name pkg)))
installed)
#'string<))
(default (car names)))
(completing-read "Installed package: " names nil 'require-match
nil nil default)))
(defun pkg-info-library-source (library)
"Get the source file of LIBRARY.
LIBRARY is either a symbol denoting a named feature, or a library
name as string.
Return the source file of LIBRARY as string."
(find-library-name (if (symbolp library) (symbol-name library) library)))
(defun pkg-info-defining-library (function)
"Get the source file of the library defining FUNCTION.
FUNCTION is a function symbol.
Return the file name of the library as string. Signal an error
if the library does not exist, or if the definition of FUNCTION
was not found."
(unless (functionp function)
(signal 'wrong-type-argument (list 'functionp function)))
(let ((library (symbol-file function 'defun)))
(unless library
(error "Can't find definition of %s" function))
library))
(defun pkg-info-x-original-version (file)
"Read the X-Original-Version header from FILE.
Return the value as version list, or return nil if FILE lacks
this header. Signal an error, if the value of the header is not
a valid version."
(let ((version-str (with-temp-buffer
(insert-file-contents file)
(lm-header "X-Original-Version"))))
(when version-str
(version-to-list version-str))))
;;;###autoload
(defun pkg-info-library-original-version (library &optional show)
"Get the original version in the header of LIBRARY.
The original version is stored in the X-Original-Version header.
This header is added by the MELPA package archive to preserve
upstream version numbers.
LIBRARY is either a symbol denoting a named feature, or a library
name as string.
If SHOW is non-nil, show the version in the minibuffer.
Return the version from the header of LIBRARY as list. Signal an
error if the LIBRARY was not found or had no X-Original-Version
header.
See Info node `(elisp)Library Headers' for more information
about library headers."
(interactive (list (pkg-info--read-library) t))
(let ((version (pkg-info-x-original-version
(pkg-info-library-source library))))
(if version
(pkg-info--show-version-and-return version show)
(error "Library %s has no original version" library))))
;;;###autoload
(defun pkg-info-library-version (library &optional show)
"Get the version in the header of LIBRARY.
LIBRARY is either a symbol denoting a named feature, or a library
name as string.
If SHOW is non-nil, show the version in the minibuffer.
Return the version from the header of LIBRARY as list. Signal an
error if the LIBRARY was not found or had no proper header.
See Info node `(elisp)Library Headers' for more information
about library headers."
(interactive (list (pkg-info--read-library) t))
(let* ((source (pkg-info-library-source library))
(version (epl-package-version (epl-package-from-file source))))
(pkg-info--show-version-and-return version show)))
;;;###autoload
(defun pkg-info-defining-library-original-version (function &optional show)
"Get the original version of the library defining FUNCTION.
The original version is stored in the X-Original-Version header.
This header is added by the MELPA package archive to preserve
upstream version numbers.
If SHOW is non-nil, show the version in mini-buffer.
This function is mainly intended to find the version of a major
or minor mode, i.e.
(pkg-info-defining-library-version 'flycheck-mode)
Return the version of the library defining FUNCTION. Signal an
error if FUNCTION is not a valid function, if its defining
library was not found, or if the library had no proper version
header."
(interactive (list (pkg-info--read-function) t))
(pkg-info-library-original-version (pkg-info-defining-library function) show))
;;;###autoload
(defun pkg-info-defining-library-version (function &optional show)
"Get the version of the library defining FUNCTION.
If SHOW is non-nil, show the version in mini-buffer.
This function is mainly intended to find the version of a major
or minor mode, i.e.
(pkg-info-defining-library-version 'flycheck-mode)
Return the version of the library defining FUNCTION. Signal an
error if FUNCTION is not a valid function, if its defining
library was not found, or if the library had no proper version
header."
(interactive (list (pkg-info--read-function) t))
(pkg-info-library-version (pkg-info-defining-library function) show))
;;;###autoload
(defun pkg-info-package-version (package &optional show)
"Get the version of an installed PACKAGE.
If SHOW is non-nil, show the version in the minibuffer.
Return the version as list, or nil if PACKAGE is not installed."
(interactive (list (pkg-info--read-package) t))
(let* ((name (if (stringp package) (intern package) package))
(package (car (epl-find-installed-packages name))))
(unless package
(error "Can't find installed package %s" name))
(pkg-info--show-version-and-return (epl-package-version package) show)))
;;;###autoload
(defun pkg-info-version-info (library &optional package show)
"Obtain complete version info for LIBRARY and PACKAGE.
LIBRARY is a symbol denoting a named feature, or a library name
as string. PACKAGE is a symbol denoting an ELPA package. If
omitted or nil, default to LIBRARY.
If SHOW is non-nil, show the version in the minibuffer.
When called interactively, prompt for LIBRARY. When called
interactively with prefix argument, prompt for PACKAGE as well.
Return a string with complete version information for LIBRARY.
This version information contains the version from the headers of
LIBRARY, and the version of the installed PACKAGE, the LIBRARY is
part of. If PACKAGE is not installed, or if the PACKAGE version
is the same as the LIBRARY version, do not include a package
version."
(interactive (list (pkg-info--read-library)
(when current-prefix-arg
(pkg-info--read-package))
t))
(let* ((package (or package (if (stringp library) (intern library) library)))
(orig-version (condition-case nil
(pkg-info-library-original-version library)
(error nil)))
;; If we have X-Original-Version, we assume that MELPA replaced the
;; library version with its generated version, so we use the
;; X-Original-Version header instead, and ignore the library version
;; header
(lib-version (or orig-version (pkg-info-library-version library)))
(pkg-version (condition-case nil
(pkg-info-package-version package)
(error nil)))
(version (if (and pkg-version
(not (version-list-= lib-version pkg-version)))
(format "%s (package: %s)"
(pkg-info-format-version lib-version)
(pkg-info-format-version pkg-version))
(pkg-info-format-version lib-version))))
(pkg-info--show-version-and-return version show)))
(defconst pkg-info-melpa-recipe-url "http://melpa.org/recipes.json"
"The URL from which to fetch MELPA recipes.")
(defvar pkg-info-melpa-recipes nil
"An alist of MELPA recipes.")
(defun pkg-info-retrieve-melpa-recipes ()
"Retrieve MELPA recipes from MELPA archive."
(let ((buffer (url-retrieve-synchronously pkg-info-melpa-recipe-url)))
(with-current-buffer buffer
(unwind-protect
(let ((response-code (url-http-parse-response)))
(unless (equal response-code 200)
(error "Failed to retrieve MELPA recipes from %s (code %s)"
pkg-info-melpa-recipe-url response-code))
(goto-char url-http-end-of-headers)
(json-read))
(when (and buffer (buffer-live-p buffer))
(kill-buffer buffer))))))
(defun pkg-info-get-melpa-recipes ()
"Get MELPA recipes."
(setq pkg-info-melpa-recipes
(or pkg-info-melpa-recipes
(pkg-info-retrieve-melpa-recipes))))
(defun pkg-info-get-melpa-recipe (package)
"Get the MELPA recipe for PACKAGE.
Return nil if PACKAGE is not on MELPA."
(cdr (assq package (pkg-info-get-melpa-recipes))))
(defun pkg-info-get-melpa-fetcher (package)
"Get the MELPA fetcher for PACKAGE."
(cdr (assq 'fetcher (pkg-info-get-melpa-recipe package))))
(defun pkg-info-wiki-package-p (package)
"Determine whether PACKAGE is build from the EmacsWiki."
(equal (pkg-info-get-melpa-fetcher package) "wiki"))
(provide 'pkg-info)
;; Local Variables:
;; indent-tabs-mode: nil
;; coding: utf-8
;; End:
;;; pkg-info.el ends here
|
