mirror of https://github.com/Chizi123/.emacs.d.git
view | history | commit | commitdiff
Chizi123
2018-11-18 8f6f2705a38e2515b6c57fda12c5be29fb9a798f
commit | author | age
5cb5f7 1 ;;; pkg-info.el --- Information about packages       -*- lexical-binding: t; -*-
C 2
3 ;; Copyright (C) 2013-2015  Sebastian Wiesner <swiesner@lunaryorn.com>
4
5 ;; Author: Sebastian Wiesner <swiesner@lunaryorn.com>
6 ;; URL: https://github.com/lunaryorn/pkg-info.el
7 ;; Package-Version: 20150517.1143
8 ;; Keywords: convenience
9 ;; Version: 0.7-cvs
10 ;; Package-Requires: ((epl "0.8"))
11
12 ;; This file is not part of GNU Emacs.
13
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.
18
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.
23
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/>.
26
27 ;;; Commentary:
28
29 ;; This library extracts information from installed packages.
30
31 ;;;; Functions:
32
33 ;; `pkg-info-library-version' extracts the version from the header of a library.
34 ;;
35 ;; `pkg-info-defining-library-version' extracts the version from the header of a
36 ;;  library defining a function.
37 ;;
38 ;; `pkg-info-package-version' gets the version of an installed package.
39 ;;
40 ;; `pkg-info-format-version' formats a version list as human readable string.
41 ;;
42 ;; `pkg-info-version-info' returns complete version information for a specific
43 ;; package.
44 ;;
45 ;; `pkg-info-get-melpa-recipe' gets the MELPA recipe for a package.
46 ;;
47 ;; `pkg-info-get-melpa-fetcher' gets the fetcher used to build a package on
48 ;; MELPA.
49 ;;
50 ;; `pkg-info-wiki-package-p' determines whether a package was build from
51 ;; EmacsWiki on MELPA.
52
53 ;;; Code:
54
55 (require 'epl)
56
57 (require 'lisp-mnt)
58 (require 'find-func)
59 (require 'json)                         ; `json-read'
60 (require 'url-http)                     ; `url-http-parse-response'
61
62 (defvar url-http-end-of-headers)
63
64
65 ;;; Version information
66 (defun pkg-info-format-version (version)
67   "Format VERSION as human-readable string.
68
69 Return a human-readable string representing VERSION."
70   ;; XXX: Find a better, more flexible way of formatting?
71   (package-version-join version))
72
73 (defsubst pkg-info--show-version-and-return (version show)
74   "Show and return VERSION.
75
76 When SHOW is non-nil, show VERSION in minibuffer.
77
78 Return VERSION."
79   (when show
80     (message (if (listp version) (pkg-info-format-version version) version)))
81   version)
82
83 (defun pkg-info--read-library ()
84   "Read a library from minibuffer."
85   (completing-read "Load library: "
86                    (apply-partially 'locate-file-completion-table
87                                     load-path
88                                     (get-load-suffixes))))
89
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))))
94
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)))
100                               installed)
101                       #'string<))
102          (default (car names)))
103     (completing-read "Installed package: " names nil 'require-match
104                      nil nil default)))
105
106 (defun pkg-info-library-source (library)
107   "Get the source file of LIBRARY.
108
109 LIBRARY is either a symbol denoting a named feature, or a library
110 name as string.
111
112 Return the source file of LIBRARY as string."
113   (find-library-name (if (symbolp library) (symbol-name library) library)))
114
115 (defun pkg-info-defining-library (function)
116   "Get the source file of the library defining FUNCTION.
117
118 FUNCTION is a function symbol.
119
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
122 was not found."
123   (unless (functionp function)
124     (signal 'wrong-type-argument (list 'functionp function)))
125   (let ((library (symbol-file function 'defun)))
126     (unless library
127       (error "Can't find definition of %s" function))
128     library))
129
130 (defun pkg-info-x-original-version (file)
131   "Read the X-Original-Version header from FILE.
132
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
135 a valid version."
136   (let ((version-str (with-temp-buffer
137                        (insert-file-contents file)
138                        (lm-header "X-Original-Version"))))
139     (when version-str
140       (version-to-list version-str))))
141
142 ;;;###autoload
143 (defun pkg-info-library-original-version (library &optional show)
144   "Get the original version in the header of LIBRARY.
145
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.
149
150 LIBRARY is either a symbol denoting a named feature, or a library
151 name as string.
152
153 If SHOW is non-nil, show the version in the minibuffer.
154
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
157 header.
158
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))))
164     (if version
165         (pkg-info--show-version-and-return version show)
166       (error "Library %s has no original version" library))))
167
168 ;;;###autoload
169 (defun pkg-info-library-version (library &optional show)
170   "Get the version in the header of LIBRARY.
171
172 LIBRARY is either a symbol denoting a named feature, or a library
173 name as string.
174
175 If SHOW is non-nil, show the version in the minibuffer.
176
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.
179
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)))
186
187 ;;;###autoload
188 (defun pkg-info-defining-library-original-version (function &optional show)
189   "Get the original version of the library defining FUNCTION.
190
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.
194
195 If SHOW is non-nil, show the version in mini-buffer.
196
197 This function is mainly intended to find the version of a major
198 or minor mode, i.e.
199
200    (pkg-info-defining-library-version 'flycheck-mode)
201
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
205 header."
206   (interactive (list (pkg-info--read-function) t))
207   (pkg-info-library-original-version (pkg-info-defining-library function) show))
208
209 ;;;###autoload
210 (defun pkg-info-defining-library-version (function &optional show)
211   "Get the version of the library defining FUNCTION.
212
213 If SHOW is non-nil, show the version in mini-buffer.
214
215 This function is mainly intended to find the version of a major
216 or minor mode, i.e.
217
218    (pkg-info-defining-library-version 'flycheck-mode)
219
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
223 header."
224   (interactive (list (pkg-info--read-function) t))
225   (pkg-info-library-version (pkg-info-defining-library function) show))
226
227 ;;;###autoload
228 (defun pkg-info-package-version (package &optional show)
229   "Get the version of an installed PACKAGE.
230
231 If SHOW is non-nil, show the version in the minibuffer.
232
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))))
237     (unless package
238       (error "Can't find installed package %s" name))
239     (pkg-info--show-version-and-return (epl-package-version package) show)))
240
241 ;;;###autoload
242 (defun pkg-info-version-info (library &optional package show)
243   "Obtain complete version info for LIBRARY and PACKAGE.
244
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.
248
249 If SHOW is non-nil, show the version in the minibuffer.
250
251 When called interactively, prompt for LIBRARY.  When called
252 interactively with prefix argument, prompt for PACKAGE as well.
253
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
259 version."
260   (interactive (list (pkg-info--read-library)
261                      (when current-prefix-arg
262                        (pkg-info--read-package))
263                      t))
264   (let* ((package (or package (if (stringp library) (intern library) library)))
265          (orig-version (condition-case nil
266                            (pkg-info-library-original-version library)
267                          (error nil)))
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
271          ;; header
272          (lib-version (or orig-version (pkg-info-library-version library)))
273          (pkg-version (condition-case nil
274                           (pkg-info-package-version package)
275                         (error nil)))
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)))
283
284 (defconst pkg-info-melpa-recipe-url "http://melpa.org/recipes.json"
285   "The URL from which to fetch MELPA recipes.")
286
287 (defvar pkg-info-melpa-recipes nil
288   "An alist of MELPA recipes.")
289
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
294       (unwind-protect
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)
300             (json-read))
301         (when (and buffer (buffer-live-p buffer))
302           (kill-buffer buffer))))))
303
304 (defun pkg-info-get-melpa-recipes ()
305   "Get MELPA recipes."
306   (setq pkg-info-melpa-recipes
307         (or pkg-info-melpa-recipes
308             (pkg-info-retrieve-melpa-recipes))))
309
310 (defun pkg-info-get-melpa-recipe (package)
311   "Get the MELPA recipe for PACKAGE.
312
313 Return nil if PACKAGE is not on MELPA."
314   (cdr (assq package (pkg-info-get-melpa-recipes))))
315
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))))
319
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"))
323
324 (provide 'pkg-info)
325
326 ;; Local Variables:
327 ;; indent-tabs-mode: nil
328 ;; coding: utf-8
329 ;; End:
330
331 ;;; pkg-info.el ends here