Commit | Line | Data |
---|---|---|
27986d7b AK |
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) | |
57748c27 | 32 | (require 'guix-license) |
27986d7b AK |
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 | ||
8934c3b6 AK |
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 | ||
27986d7b AK |
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 | |
8934c3b6 | 63 | :message-function 'guix-license-message |
27986d7b AK |
64 | :format '((name ignore (simple guix-info-heading)) |
65 | ignore | |
66 | guix-license-insert-packages-button | |
67 | (url ignore (simple guix-url)) | |
57748c27 AK |
68 | guix-license-insert-comment |
69 | ignore | |
70 | guix-license-insert-file) | |
27986d7b AK |
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 | ||
57748c27 AK |
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 | ||
27986d7b AK |
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 | |
8934c3b6 | 112 | :message-function 'guix-license-message |
27986d7b AK |
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)) | |
557361e7 | 119 | (define-key map (kbd "e") 'guix-license-list-edit) |
27986d7b AK |
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 | ||
557361e7 AK |
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 | ||
27986d7b AK |
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 |