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 (require 'guix-license)
  33
  34 (guix-define-entry-type license)
  35
  36 (defun guix-license-get-entries (search-type &rest args)
  37   "Receive 'license' entries.
  38 SEARCH-TYPE may be one of the following symbols: `all', `id', `name'."
  39   (guix-eval-read
  40    (apply #'guix-make-guile-expression
  41           'license-entries search-type args)))
  42
  43 (defun guix-license-get-display (search-type &rest args)
  44   "Search for licenses and show results."
  45   (apply #'guix-list-get-display-entries
  46          'license search-type args))
  47
  48 (defun guix-license-message (entries search-type &rest args)
  49   "Display a message after showing license ENTRIES."
  50   ;; Some objects in (guix licenses) module are procedures (e.g.,
  51   ;; 'non-copyleft' or 'x11-style').  Such licenses cannot be "described".
  52   (when (null entries)
  53     (if (cdr args)
  54         (message "Unknown licenses.")
  55       (message "Unknown license."))))
  56
  57 \f
  58 ;;; License 'info'
  59
  60 (guix-info-define-interface license
  61   :buffer-name "*Guix License Info*"
  62   :get-entries-function 'guix-license-get-entries
  63   :message-function 'guix-license-message
  64   :format '((name ignore (simple guix-info-heading))
  65             ignore
  66             guix-license-insert-packages-button
  67             (url ignore (simple guix-url))
  68             guix-license-insert-comment
  69             ignore
  70             guix-license-insert-file)
  71   :titles '((url . "URL")))
  72
  73 (declare-function guix-packages-by-license "guix-ui-package")
  74
  75 (defun guix-license-insert-packages-button (entry)
  76   "Insert button to display packages by license ENTRY."
  77   (let ((license (guix-entry-value entry 'name)))
  78     (guix-info-insert-action-button
  79      "Packages"
  80      (lambda (btn)
  81        (guix-packages-by-license (button-get btn 'license)))
  82      (format "Display packages with license '%s'" license)
  83      'license license)))
  84
  85 (defun guix-license-insert-comment (entry)
  86   "Insert 'comment' of a license ENTRY."
  87   (let ((comment (guix-entry-value entry 'comment)))
  88     (if (and comment
  89              (string-match-p "^http" comment))
  90         (guix-info-insert-value-simple comment 'guix-url)
  91       (guix-info-insert-title-simple
  92        (guix-info-param-title 'license 'comment))
  93       (guix-info-insert-value-indent comment))))
  94
  95 (defun guix-license-insert-file (entry)
  96   "Insert button to open license definition."
  97   (let ((license (guix-entry-value entry 'name)))
  98     (guix-insert-button
  99      (guix-license-file) 'guix-file
 100      'help-echo (format "Open definition of license '%s'" license)
 101      'action (lambda (btn)
 102                (guix-find-license-definition (button-get btn 'license)))
 103      'license license)))
 104
 105 \f
 106 ;;; License 'list'
 107
 108 (guix-list-define-interface license
 109   :buffer-name "*Guix Licenses*"
 110   :get-entries-function 'guix-license-get-entries
 111   :describe-function 'guix-license-list-describe
 112   :message-function 'guix-license-message
 113   :format '((name nil 40 t)
 114             (url guix-list-get-url 50 t))
 115   :titles '((name . "License"))
 116   :sort-key '(name))
 117
 118 (let ((map guix-license-list-mode-map))
 119   (define-key map (kbd "e")   'guix-license-list-edit)
 120   (define-key map (kbd "RET") 'guix-license-list-show-packages))
 121
 122 (defun guix-license-list-describe (ids)
 123   "Describe licenses with IDS (list of identifiers)."
 124   (guix-buffer-display-entries
 125    (guix-entries-by-ids ids (guix-buffer-current-entries))
 126    'info 'license (cl-list* 'id ids) 'add))
 127
 128 (defun guix-license-list-show-packages ()
 129   "Display packages with the license at point."
 130   (interactive)
 131   (guix-packages-by-license (guix-list-current-id)))
 132
 133 (defun guix-license-list-edit (&optional directory)
 134   "Go to the location of the current license definition.
 135 See `guix-license-file' for the meaning of DIRECTORY."
 136   (interactive (list (guix-read-directory)))
 137   (guix-find-license-definition (guix-list-current-id) directory))
 138
 139 \f
 140 ;;; Interactive commands
 141
 142 ;;;###autoload
 143 (defun guix-licenses ()
 144   "Display licenses of the Guix packages."
 145   (interactive)
 146   (guix-license-get-display 'all))
 147
 148 (provide 'guix-ui-license)
 149
 150 ;;; guix-ui-license.el ends here