From 687c9bc0233facde4068ea7f9fed2b2ae931adab Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Thu, 21 Jan 2016 22:07:10 +0300
Subject: [PATCH] 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.
---
 NEWS                  |  1 +
 doc/emacs.texi        | 22 +++++++++++
 doc/guix.texi         |  1 +
 emacs/guix-license.el | 86 +++++++++++++++++++++++++++++++++++++++++++
 emacs/guix-main.scm   | 22 +++++++++++
 5 files changed, 132 insertions(+)

diff --git a/NEWS b/NEWS
index b27ebc7009..010789e2e4 100644
--- a/NEWS
+++ b/NEWS
@@ -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
diff --git a/doc/emacs.texi b/doc/emacs.texi
index e72a386303..8020e0ace3 100644
--- a/doc/emacs.texi
+++ b/doc/emacs.texi
@@ -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
 
diff --git a/doc/guix.texi b/doc/guix.texi
index a650a55d51..8476408ec9 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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.
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)))