emacs: Add interface for licenses.

* emacs/guix-main.scm (%license-param-alist): New variable.
  (license->sexp, find-licenses, license-entries): New procedures.
* emacs/guix-license.el (guix-license-get-entries)
  (guix-license-get-display, guix-license-insert-packages-button)
  (guix-license-insert-comment, guix-license-list-describe)
  (guix-license-list-show-packages): New procedures.
  (guix-licenses): New command.
* doc/emacs.texi (Emacs Licenses): New node.
  (Emacs Interface): Add it.
* doc/guix.texi (Top): Add it.
* NEWS: Mention new interface.
This commit is contained in:
Alex Kost 2016-01-21 22:07:10 +03:00
parent 6dd460c856
commit 687c9bc023
5 changed files with 132 additions and 0 deletions

1
NEWS
View file

@ -14,6 +14,7 @@ Please send Guix bug reports to bug-guix@gnu.org.
** Package management
*** Emacs interface for licenses
*** Emacs interface for system generations
*** Emacs interface for hydra.gnu.org
*** Changes in Emacs interface variables and faces

View file

@ -9,6 +9,7 @@ Guix convenient and fun.
@menu
* Initial Setup: Emacs Initial Setup. Preparing @file{~/.emacs}.
* Package Management: Emacs Package Management. Managing packages and generations.
* Licenses: Emacs Licenses. Interface for licenses of Guix packages.
* Popup Interface: Emacs Popup Interface. Magit-like interface for guix commands.
* Prettify Mode: Emacs Prettify. Abbreviating @file{/gnu/store/@dots{}} file names.
* Build Log Mode: Emacs Build Log. Highlighting Guix build logs.
@ -520,6 +521,27 @@ Various settings for ``info'' buffers.
@end table
@node Emacs Licenses
@section Licenses
If you want to browse the URL of a particular license, or to look at a
list of licenses, you may use the following commands:
@table @kbd
@item M-x guix-browse-license-url
Choose a license from a completion list to browse its URL using
@code{browse-url} function (@pxref{Browse-URL,,, emacs, The GNU Emacs
Manual}).
@item M-x guix-licenses
Display a list of available licenses. You can press @kbd{@key{RET}}
there to display packages with this license in the same way as @kbd{M-x
guix-packages-by-license} would do (@pxref{Emacs Commands}).
@end table
@node Emacs Popup Interface
@section Popup Interface

View file

@ -111,6 +111,7 @@ Emacs Interface
* Initial Setup: Emacs Initial Setup. Preparing @file{~/.emacs}.
* Package Management: Emacs Package Management. Managing packages and generations.
* Licenses: Emacs Licenses. Interface for licenses of Guix packages.
* Popup Interface: Emacs Popup Interface. Magit-like interface for guix commands.
* Prettify Mode: Emacs Prettify. Abbreviating @file{/gnu/store/@dots{}} file names.
* Build Log Mode: Emacs Build Log. Highlighting Guix build logs.

View file

@ -23,22 +23,108 @@
;;; Code:
(require 'guix-buffer)
(require 'guix-list)
(require 'guix-info)
(require 'guix-read)
(require 'guix-backend)
(require 'guix-guile)
(guix-define-entry-type license)
(defun guix-lookup-license-url (license)
"Return URL of a LICENSE."
(or (guix-eval-read (guix-make-guile-expression
'lookup-license-uri license))
(error "Hm, I don't know URL of '%s' license" license)))
(defun guix-license-get-entries (search-type &rest args)
"Receive 'license' entries.
SEARCH-TYPE may be one of the following symbols: `all', `id', `name'."
(guix-eval-read
(apply #'guix-make-guile-expression
'license-entries search-type args)))
(defun guix-license-get-display (search-type &rest args)
"Search for licenses and show results."
(apply #'guix-list-get-display-entries
'license search-type args))
;;; License 'info'
(guix-info-define-interface license
:buffer-name "*Guix License Info*"
:get-entries-function 'guix-license-get-entries
:format '((name ignore (simple guix-info-heading))
ignore
guix-license-insert-packages-button
(url ignore (simple guix-url))
guix-license-insert-comment)
:titles '((url . "URL")))
(declare-function guix-packages-by-license "guix-ui-package")
(defun guix-license-insert-packages-button (entry)
"Insert button to display packages by license ENTRY."
(guix-info-insert-action-button
"Packages"
(lambda (btn)
(guix-packages-by-license (button-get btn 'license)))
"Show packages with this license"
'license (guix-entry-value entry 'name)))
(defun guix-license-insert-comment (entry)
"Insert 'comment' of a license ENTRY."
(let ((comment (guix-entry-value entry 'comment)))
(if (and comment
(string-match-p "^http" comment))
(guix-info-insert-value-simple comment 'guix-url)
(guix-info-insert-title-simple
(guix-info-param-title 'license 'comment))
(guix-info-insert-value-indent comment))))
;;; License 'list'
(guix-list-define-interface license
:buffer-name "*Guix Licenses*"
:get-entries-function 'guix-license-get-entries
:describe-function 'guix-license-list-describe
:format '((name nil 40 t)
(url guix-list-get-url 50 t))
:titles '((name . "License"))
:sort-key '(name))
(let ((map guix-license-list-mode-map))
(define-key map (kbd "RET") 'guix-license-list-show-packages))
(defun guix-license-list-describe (ids)
"Describe licenses with IDS (list of identifiers)."
(guix-buffer-display-entries
(guix-entries-by-ids ids (guix-buffer-current-entries))
'info 'license (cl-list* 'id ids) 'add))
(defun guix-license-list-show-packages ()
"Display packages with the license at point."
(interactive)
(guix-packages-by-license (guix-list-current-id)))
;;; Interactive commands
;;;###autoload
(defun guix-browse-license-url (license)
"Browse URL of a LICENSE."
(interactive (list (guix-read-license-name)))
(browse-url (guix-lookup-license-url license)))
;;;###autoload
(defun guix-licenses ()
"Display licenses of the Guix packages."
(interactive)
(guix-license-get-display 'all))
(provide 'guix-license)
;;; guix-license.el ends here

View file

@ -1083,3 +1083,25 @@ (define (lookup-license-uri name)
"Return a license URI by its name."
(and=> (lookup-license name)
license-uri))
(define %license-param-alist
`((id . ,license-name)
(name . ,license-name)
(url . ,license-uri)
(comment . ,license-comment)))
(define license->sexp
(object-transformer %license-param-alist))
(define (find-licenses search-type . search-values)
"Return a list of licenses depending on SEARCH-TYPE and SEARCH-VALUES."
(case search-type
((id name)
(let ((names search-values))
(filter-map lookup-license names)))
((all)
(licenses))))
(define (license-entries search-type . search-values)
(map license->sexp
(apply find-licenses search-type search-values)))