From 83aab70b2d4d11fa345c1fbf2ccdbec8b7ad6662 Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Wed, 20 Jan 2016 18:53:19 +0300
Subject: [PATCH] emacs: Add 'guix-packages-by-license' command.

* emacs/guix-main.scm (packages-by-license): New procedure.
(%patterns-makers): Add 'license' search type.
* emacs/guix-messages.el (guix-message-packages-by-license): New procedure.
(guix-messages): Use it.
* emacs/guix-ui-package.el (guix-packages-by-license): New command.
* doc/emacs.texi (Emacs Commands): Document it.
---
 doc/emacs.texi           |  3 +++
 emacs/guix-main.scm      | 11 +++++++++++
 emacs/guix-messages.el   | 15 +++++++++++++++
 emacs/guix-ui-package.el | 12 ++++++++++++
 4 files changed, 41 insertions(+)

diff --git a/doc/emacs.texi b/doc/emacs.texi
index d321a89d4d..e72a386303 100644
--- a/doc/emacs.texi
+++ b/doc/emacs.texi
@@ -158,6 +158,9 @@ but cannot be found among available packages).
 @item M-x guix-packages-by-name
 Display package(s) with the specified name.
 
+@item M-x guix-packages-by-license
+Display package(s) with the specified license.
+
 @item M-x guix-search-by-regexp
 Search for packages by a specified regexp.  By default ``name'',
 ``synopsis'' and ``description'' of the packages will be searched.  This
diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm
index 0aee206a15..bec26c7c40 100644
--- a/emacs/guix-main.scm
+++ b/emacs/guix-main.scm
@@ -403,6 +403,12 @@ MATCH-PARAMS is a list of parameters that REGEXP can match."
   (let ((re (make-regexp regexp regexp/icase)))
     (matching-packages (cut package-match? <> re))))
 
+(define (packages-by-license license)
+  "Return a list of packages with LICENSE."
+  (matching-packages
+   (lambda (package)
+     (memq license (list-maybe (package-license package))))))
+
 (define (all-available-packages)
   "Return a list of all available packages."
   (matching-packages (const #t)))
@@ -663,6 +669,9 @@ ENTRIES is a list of installed manifest entries."
          (manifest-output-proc  (apply-to-first manifest-output-patterns))
          (regexp-proc           (lambda (_ regexp params . __)
                                   (packages-by-regexp regexp params)))
+         (license-proc          (lambda (_ license-name)
+                                  (packages-by-license
+                                   (lookup-license license-name))))
          (all-proc              (lambda _ (all-available-packages)))
          (newest-proc           (lambda _ (newest-available-packages))))
     `((package
@@ -671,6 +680,7 @@ ENTRIES is a list of installed manifest entries."
        (installed        . ,manifest-package-proc)
        (obsolete         . ,(apply-to-first obsolete-package-patterns))
        (regexp           . ,regexp-proc)
+       (license          . ,license-proc)
        (all-available    . ,all-proc)
        (newest-available . ,newest-proc))
       (output
@@ -679,6 +689,7 @@ ENTRIES is a list of installed manifest entries."
        (installed        . ,manifest-output-proc)
        (obsolete         . ,(apply-to-first obsolete-output-patterns))
        (regexp           . ,regexp-proc)
+       (license          . ,license-proc)
        (all-available    . ,all-proc)
        (newest-available . ,newest-proc)))))
 
diff --git a/emacs/guix-messages.el b/emacs/guix-messages.el
index c4f15dcac2..de0331fff8 100644
--- a/emacs/guix-messages.el
+++ b/emacs/guix-messages.el
@@ -36,6 +36,10 @@
      (name
       ,(lambda (_ entries names)
          (guix-message-packages-by-name entries 'package names)))
+     (license
+      ,(lambda (_ entries licenses)
+         (apply #'guix-message-packages-by-license
+                entries 'package licenses)))
      (regexp
       (0 "No packages matching '%s'." val)
       (1 "A single package matching '%s'." val)
@@ -64,6 +68,10 @@
      (name
       ,(lambda (_ entries names)
          (guix-message-packages-by-name entries 'output names)))
+     (license
+      ,(lambda (_ entries licenses)
+         (apply #'guix-message-packages-by-license
+                entries 'output licenses)))
      (regexp
       (0 "No package outputs matching '%s'." val)
       (1 "A single package output matching '%s'." val)
@@ -159,6 +167,13 @@ Try \"M-x guix-search-by-name\"."
                             (guix-message-string-name (car names))))))
     (message "%s %s." str-beg str-end)))
 
+(defun guix-message-packages-by-license (entries entry-type license)
+  "Display a message for packages or outputs searched by LICENSE."
+  (let* ((count (length entries))
+         (str-beg (guix-message-string-entries count entry-type))
+         (str-end (format "with license '%s'" license)))
+    (message "%s %s." str-beg str-end)))
+
 (defun guix-message-generations-by-time (profile entries times)
   "Display a message for generations searched by TIMES."
   (let* ((count (length entries))
diff --git a/emacs/guix-ui-package.el b/emacs/guix-ui-package.el
index 655ed74472..414bc9b9d2 100644
--- a/emacs/guix-ui-package.el
+++ b/emacs/guix-ui-package.el
@@ -35,6 +35,7 @@
 (require 'guix-entry)
 (require 'guix-utils)
 (require 'guix-hydra-build)
+(require 'guix-read)
 (require 'guix-license)
 
 (guix-ui-define-entry-type package)
@@ -932,6 +933,17 @@ Interactively with prefix, prompt for PROFILE."
          (guix-ui-read-profile)))
   (guix-package-get-display profile 'name name))
 
+;;;###autoload
+(defun guix-packages-by-license (license &optional profile)
+  "Display Guix packages with LICENSE.
+LICENSE is a license name string.
+If PROFILE is nil, use `guix-current-profile'.
+Interactively with prefix, prompt for PROFILE."
+  (interactive
+   (list (guix-read-license-name)
+         (guix-ui-read-profile)))
+  (guix-package-get-display profile 'license license))
+
 ;;;###autoload
 (defun guix-search-by-regexp (regexp &optional params profile)
   "Search for Guix packages by REGEXP.