elpa/pkg-info-20150517.1143/pkg-info.el

   1 ;;; pkg-info.el --- Information about packages       -*- lexical-binding: t; -*-
   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 \f
  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