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.master
parent
6dd460c856
commit
687c9bc023
1
NEWS
1
NEWS
|
@ -14,6 +14,7 @@ Please send Guix bug reports to bug-guix@gnu.org.
|
||||||
|
|
||||||
** Package management
|
** Package management
|
||||||
|
|
||||||
|
*** Emacs interface for licenses
|
||||||
*** Emacs interface for system generations
|
*** Emacs interface for system generations
|
||||||
*** Emacs interface for hydra.gnu.org
|
*** Emacs interface for hydra.gnu.org
|
||||||
*** Changes in Emacs interface variables and faces
|
*** Changes in Emacs interface variables and faces
|
||||||
|
|
|
@ -9,6 +9,7 @@ Guix convenient and fun.
|
||||||
@menu
|
@menu
|
||||||
* Initial Setup: Emacs Initial Setup. Preparing @file{~/.emacs}.
|
* Initial Setup: Emacs Initial Setup. Preparing @file{~/.emacs}.
|
||||||
* Package Management: Emacs Package Management. Managing packages and generations.
|
* 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.
|
* Popup Interface: Emacs Popup Interface. Magit-like interface for guix commands.
|
||||||
* Prettify Mode: Emacs Prettify. Abbreviating @file{/gnu/store/@dots{}} file names.
|
* Prettify Mode: Emacs Prettify. Abbreviating @file{/gnu/store/@dots{}} file names.
|
||||||
* Build Log Mode: Emacs Build Log. Highlighting Guix build logs.
|
* Build Log Mode: Emacs Build Log. Highlighting Guix build logs.
|
||||||
|
@ -520,6 +521,27 @@ Various settings for ``info'' buffers.
|
||||||
@end table
|
@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
|
@node Emacs Popup Interface
|
||||||
@section Popup Interface
|
@section Popup Interface
|
||||||
|
|
||||||
|
|
|
@ -111,6 +111,7 @@ Emacs Interface
|
||||||
|
|
||||||
* Initial Setup: Emacs Initial Setup. Preparing @file{~/.emacs}.
|
* Initial Setup: Emacs Initial Setup. Preparing @file{~/.emacs}.
|
||||||
* Package Management: Emacs Package Management. Managing packages and generations.
|
* 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.
|
* Popup Interface: Emacs Popup Interface. Magit-like interface for guix commands.
|
||||||
* Prettify Mode: Emacs Prettify. Abbreviating @file{/gnu/store/@dots{}} file names.
|
* Prettify Mode: Emacs Prettify. Abbreviating @file{/gnu/store/@dots{}} file names.
|
||||||
* Build Log Mode: Emacs Build Log. Highlighting Guix build logs.
|
* Build Log Mode: Emacs Build Log. Highlighting Guix build logs.
|
||||||
|
|
|
@ -23,22 +23,108 @@
|
||||||
|
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'guix-buffer)
|
||||||
|
(require 'guix-list)
|
||||||
|
(require 'guix-info)
|
||||||
(require 'guix-read)
|
(require 'guix-read)
|
||||||
(require 'guix-backend)
|
(require 'guix-backend)
|
||||||
(require 'guix-guile)
|
(require 'guix-guile)
|
||||||
|
|
||||||
|
(guix-define-entry-type license)
|
||||||
|
|
||||||
(defun guix-lookup-license-url (license)
|
(defun guix-lookup-license-url (license)
|
||||||
"Return URL of a LICENSE."
|
"Return URL of a LICENSE."
|
||||||
(or (guix-eval-read (guix-make-guile-expression
|
(or (guix-eval-read (guix-make-guile-expression
|
||||||
'lookup-license-uri license))
|
'lookup-license-uri license))
|
||||||
(error "Hm, I don't know URL of '%s' license" 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
|
;;;###autoload
|
||||||
(defun guix-browse-license-url (license)
|
(defun guix-browse-license-url (license)
|
||||||
"Browse URL of a LICENSE."
|
"Browse URL of a LICENSE."
|
||||||
(interactive (list (guix-read-license-name)))
|
(interactive (list (guix-read-license-name)))
|
||||||
(browse-url (guix-lookup-license-url license)))
|
(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)
|
(provide 'guix-license)
|
||||||
|
|
||||||
;;; guix-license.el ends here
|
;;; guix-license.el ends here
|
||||||
|
|
|
@ -1083,3 +1083,25 @@ Return #t if the shell command was executed successfully."
|
||||||
"Return a license URI by its name."
|
"Return a license URI by its name."
|
||||||
(and=> (lookup-license name)
|
(and=> (lookup-license name)
|
||||||
license-uri))
|
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)))
|
||||||
|
|
Reference in New Issue