1 files changed, 63 insertions, 0 deletions
diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm
index 236c882e3c..335686ed25 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)))))
 
@@ -1042,3 +1053,55 @@ Return #t if the shell command was executed successfully."
 ;; See the comment to 'guix-package-names' function in "guix-popup.el".
 (define (package-names-lists)
   (map list (package-names)))
+
+
+;;; Licenses
+
+(define %licenses
+  (delay
+    (filter license?
+            (module-map (lambda (_ var)
+                          (variable-ref var))
+                        (resolve-interface '(guix licenses))))))
+
+(define (licenses)
+  (force %licenses))
+
+(define (license-names)
+  "Return a list of names of available licenses."
+  (map license-name (licenses)))
+
+(define lookup-license
+  (memoize
+   (lambda (name)
+     "Return a license by its name."
+     (find (lambda (l)
+             (string=? name (license-name l)))
+           (licenses)))))
+
+(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)))