emacs/guix-ui-license.el

   1 ;;; guix-ui-license.el --- Interface for displaying licenses
   2
   3 ;; Copyright © 2016 Alex Kost <alezost@gmail.com>
   4
   5 ;; This file is part of GNU Guix.
   6
   7 ;; GNU Guix is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; GNU Guix is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 ;;; Commentary:
  21
  22 ;; This file provides 'list'/'info' interface for displaying licenses of
  23 ;; Guix packages.
  24
  25 ;;; Code:
  26
  27 (require 'guix-buffer)
  28 (require 'guix-list)
  29 (require 'guix-info)
  30 (require 'guix-backend)
  31 (require 'guix-guile)
  32
  33 (guix-define-entry-type license)
  34
  35 (defun guix-license-get-entries (search-type &rest args)
  36   "Receive 'license' entries.
  37 SEARCH-TYPE may be one of the following symbols: `all', `id', `name'."
  38   (guix-eval-read
  39    (apply #'guix-make-guile-expression
  40           'license-entries search-type args)))
  41
  42 (defun guix-license-get-display (search-type &rest args)
  43   "Search for licenses and show results."
  44   (apply #'guix-list-get-display-entries
  45          'license search-type args))
  46
  47 \f
  48 ;;; License 'info'
  49
  50 (guix-info-define-interface license
  51   :buffer-name "*Guix License Info*"
  52   :get-entries-function 'guix-license-get-entries
  53   :format '((name ignore (simple guix-info-heading))
  54             ignore
  55             guix-license-insert-packages-button
  56             (url ignore (simple guix-url))
  57             guix-license-insert-comment)
  58   :titles '((url . "URL")))
  59
  60 (declare-function guix-packages-by-license "guix-ui-package")
  61
  62 (defun guix-license-insert-packages-button (entry)
  63   "Insert button to display packages by license ENTRY."
  64   (let ((license (guix-entry-value entry 'name)))
  65     (guix-info-insert-action-button
  66      "Packages"
  67      (lambda (btn)
  68        (guix-packages-by-license (button-get btn 'license)))
  69      (format "Display packages with license '%s'" license)
  70      'license license)))
  71
  72 (defun guix-license-insert-comment (entry)
  73   "Insert 'comment' of a license ENTRY."
  74   (let ((comment (guix-entry-value entry 'comment)))
  75     (if (and comment
  76              (string-match-p "^http" comment))
  77         (guix-info-insert-value-simple comment 'guix-url)
  78       (guix-info-insert-title-simple
  79        (guix-info-param-title 'license 'comment))
  80       (guix-info-insert-value-indent comment))))
  81
  82 \f
  83 ;;; License 'list'
  84
  85 (guix-list-define-interface license
  86   :buffer-name "*Guix Licenses*"
  87   :get-entries-function 'guix-license-get-entries
  88   :describe-function 'guix-license-list-describe
  89   :format '((name nil 40 t)
  90             (url guix-list-get-url 50 t))
  91   :titles '((name . "License"))
  92   :sort-key '(name))
  93
  94 (let ((map guix-license-list-mode-map))
  95   (define-key map (kbd "RET") 'guix-license-list-show-packages))
  96
  97 (defun guix-license-list-describe (ids)
  98   "Describe licenses with IDS (list of identifiers)."
  99   (guix-buffer-display-entries
 100    (guix-entries-by-ids ids (guix-buffer-current-entries))
 101    'info 'license (cl-list* 'id ids) 'add))
 102
 103 (defun guix-license-list-show-packages ()
 104   "Display packages with the license at point."
 105   (interactive)
 106   (guix-packages-by-license (guix-list-current-id)))
 107
 108 \f
 109 ;;; Interactive commands
 110
 111 ;;;###autoload
 112 (defun guix-licenses ()
 113   "Display licenses of the Guix packages."
 114   (interactive)
 115   (guix-license-get-display 'all))
 116
 117 (provide 'guix-ui-license)
 118
 119 ;;; guix-ui-license.el ends here