aboutsummaryrefslogtreecommitdiff
path: root/emacs
diff options
context:
space:
mode:
authorAlex Kost <alezost@gmail.com>2016-01-21 22:07:10 +0300
committerAlex Kost <alezost@gmail.com>2016-01-25 22:11:47 +0300
commit687c9bc0233facde4068ea7f9fed2b2ae931adab (patch)
treeb7416d582c3354c856ba1fa64704434cebfde7dc /emacs
parent6dd460c8565882a9ef3f76cc259bbfe1a9342b6e (diff)
downloadguix-687c9bc0233facde4068ea7f9fed2b2ae931adab.tar
guix-687c9bc0233facde4068ea7f9fed2b2ae931adab.tar.gz
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.
Diffstat (limited to 'emacs')
-rw-r--r--emacs/guix-license.el86
-rw-r--r--emacs/guix-main.scm22
2 files changed, 108 insertions, 0 deletions
diff --git a/emacs/guix-license.el b/emacs/guix-license.el
index 940f5518e2..a99d7af98d 100644
--- a/emacs/guix-license.el
+++ b/emacs/guix-license.el
@@ -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
diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm
index bec26c7c40..335686ed25 100644
--- a/emacs/guix-main.scm
+++ b/emacs/guix-main.scm
@@ -1083,3 +1083,25 @@ Return #t if the shell command was executed successfully."
"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)))