333 lines
12 KiB
EmacsLisp
333 lines
12 KiB
EmacsLisp
;;; 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
|
||
;; Package-Commit: 76ba7415480687d05a4353b27fea2ae02b8d9d61
|
||
;; 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
|