| 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 | |
