diff options
Diffstat (limited to 'emacs')
| -rw-r--r-- | emacs/guix-info.el | 6 | ||||
| -rw-r--r-- | emacs/guix-license.el | 130 | ||||
| -rw-r--r-- | emacs/guix-list.el | 27 | ||||
| -rw-r--r-- | emacs/guix-main.scm | 63 | ||||
| -rw-r--r-- | emacs/guix-messages.el | 15 | ||||
| -rw-r--r-- | emacs/guix-read.el | 11 | ||||
| -rw-r--r-- | emacs/guix-ui-generation.el | 2 | ||||
| -rw-r--r-- | emacs/guix-ui-package.el | 24 | ||||
| -rw-r--r-- | emacs/guix-ui-system-generation.el | 2 |
9 files changed, 265 insertions, 15 deletions
diff --git a/emacs/guix-info.el b/emacs/guix-info.el index 644533eb29..6aefd2f3f6 100644 --- a/emacs/guix-info.el +++ b/emacs/guix-info.el @@ -42,9 +42,9 @@ "Face used for titles of parameters." :group 'guix-info-faces) -(defface guix-info-file-path +(defface guix-info-file-name '((t :inherit link)) - "Face used for file paths." + "Face used for file names." :group 'guix-info-faces) (defface guix-info-url @@ -337,7 +337,7 @@ BUTTON-OR-FACE is a button type)." (define-button-type 'guix-file :supertype 'guix - 'face 'guix-info-file-path + 'face 'guix-info-file-name 'help-echo "Find file" 'action (lambda (btn) (guix-find-file (button-label btn)))) diff --git a/emacs/guix-license.el b/emacs/guix-license.el new file mode 100644 index 0000000000..a99d7af98d --- /dev/null +++ b/emacs/guix-license.el @@ -0,0 +1,130 @@ +;;; guix-license.el --- Licenses + +;; Copyright © 2016 Alex Kost <alezost@gmail.com> + +;; This file is part of GNU Guix. + +;; GNU Guix is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Guix is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This file provides the code to work with licenses of Guix packages. + +;;; Code: + +(require 'guix-buffer) +(require 'guix-list) +(require 'guix-info) +(require 'guix-read) +(require 'guix-backend) +(require 'guix-guile) + +(guix-define-entry-type license) + +(defun guix-lookup-license-url (license) + "Return URL of a LICENSE." + (or (guix-eval-read (guix-make-guile-expression + 'lookup-license-uri license)) + (error "Hm, I don't know URL of '%s' license" license))) + +(defun guix-license-get-entries (search-type &rest args) + "Receive 'license' entries. +SEARCH-TYPE may be one of the following symbols: `all', `id', `name'." + (guix-eval-read + (apply #'guix-make-guile-expression + 'license-entries search-type args))) + +(defun guix-license-get-display (search-type &rest args) + "Search for licenses and show results." + (apply #'guix-list-get-display-entries + 'license search-type args)) + + +;;; License 'info' + +(guix-info-define-interface license + :buffer-name "*Guix License Info*" + :get-entries-function 'guix-license-get-entries + :format '((name ignore (simple guix-info-heading)) + ignore + guix-license-insert-packages-button + (url ignore (simple guix-url)) + guix-license-insert-comment) + :titles '((url . "URL"))) + +(declare-function guix-packages-by-license "guix-ui-package") + +(defun guix-license-insert-packages-button (entry) + "Insert button to display packages by license ENTRY." + (guix-info-insert-action-button + "Packages" + (lambda (btn) + (guix-packages-by-license (button-get btn 'license))) + "Show packages with this license" + 'license (guix-entry-value entry 'name))) + +(defun guix-license-insert-comment (entry) + "Insert 'comment' of a license ENTRY." + (let ((comment (guix-entry-value entry 'comment))) + (if (and comment + (string-match-p "^http" comment)) + (guix-info-insert-value-simple comment 'guix-url) + (guix-info-insert-title-simple + (guix-info-param-title 'license 'comment)) + (guix-info-insert-value-indent comment)))) + + +;;; License 'list' + +(guix-list-define-interface license + :buffer-name "*Guix Licenses*" + :get-entries-function 'guix-license-get-entries + :describe-function 'guix-license-list-describe + :format '((name nil 40 t) + (url guix-list-get-url 50 t)) + :titles '((name . "License")) + :sort-key '(name)) + +(let ((map guix-license-list-mode-map)) + (define-key map (kbd "RET") 'guix-license-list-show-packages)) + +(defun guix-license-list-describe (ids) + "Describe licenses with IDS (list of identifiers)." + (guix-buffer-display-entries + (guix-entries-by-ids ids (guix-buffer-current-entries)) + 'info 'license (cl-list* 'id ids) 'add)) + +(defun guix-license-list-show-packages () + "Display packages with the license at point." + (interactive) + (guix-packages-by-license (guix-list-current-id))) + + +;;; Interactive commands + +;;;###autoload +(defun guix-browse-license-url (license) + "Browse URL of a LICENSE." + (interactive (list (guix-read-license-name))) + (browse-url (guix-lookup-license-url license))) + +;;;###autoload +(defun guix-licenses () + "Display licenses of the Guix packages." + (interactive) + (guix-license-get-display 'all)) + +(provide 'guix-license) + +;;; guix-license.el ends here diff --git a/emacs/guix-list.el b/emacs/guix-list.el index 7e57f42cb2..c91c67cb29 100644 --- a/emacs/guix-list.el +++ b/emacs/guix-list.el @@ -33,9 +33,14 @@ (guix-define-buffer-type list) -(defface guix-list-file-path - '((t :inherit guix-info-file-path)) - "Face used for file paths." +(defface guix-list-file-name + '((t :inherit guix-info-file-name)) + "Face used for file names." + :group 'guix-list-faces) + +(defface guix-list-url + '((t :inherit guix-info-url)) + "Face used for URLs." :group 'guix-list-faces) (defface guix-list-time @@ -214,14 +219,22 @@ VAL may be nil." (guix-get-string (guix-get-time-string seconds) 'guix-list-time)) -(defun guix-list-get-file-path (path &optional _) - "Return PATH button specification for `tabulated-list-entries'." - (list path - 'face 'guix-list-file-path +(defun guix-list-get-file-name (file-name &optional _) + "Return FILE-NAME button specification for `tabulated-list-entries'." + (list file-name + 'face 'guix-list-file-name 'action (lambda (btn) (find-file (button-label btn))) 'follow-link t 'help-echo "Find file")) +(defun guix-list-get-url (url &optional _) + "Return URL button specification for `tabulated-list-entries'." + (list url + 'face 'guix-list-url + 'action (lambda (btn) (browse-url (button-label btn))) + 'follow-link t + 'help-echo "Browse URL")) + ;;; 'List' lines 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))) 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-read.el b/emacs/guix-read.el index 3bc7b16587..a1a6b86364 100644 --- a/emacs/guix-read.el +++ b/emacs/guix-read.el @@ -1,6 +1,6 @@ ;;; guix-read.el --- Minibuffer readers -;; Copyright © 2015 Alex Kost <alezost@gmail.com> +;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com> ;; This file is part of GNU Guix. @@ -58,6 +58,10 @@ 'package-names-lists))) #'string<)) +(guix-memoized-defun guix-license-names () + "Return a list of names of available licenses." + (guix-eval-read (guix-make-guile-expression 'license-names))) + ;;; Readers @@ -122,6 +126,11 @@ :multiple-prompt "Package,s: " :multiple-separator " ") +(guix-define-readers + :completions-getter guix-license-names + :single-reader guix-read-license-name + :single-prompt "License: ") + (provide 'guix-read) ;;; guix-read.el ends here diff --git a/emacs/guix-ui-generation.el b/emacs/guix-ui-generation.el index 4047850f23..74b8ff2579 100644 --- a/emacs/guix-ui-generation.el +++ b/emacs/guix-ui-generation.el @@ -166,7 +166,7 @@ current profile's GENERATION." :format '((number nil 5 guix-list-sort-numerically-0 :right-align t) (current guix-generation-list-get-current 10 t) (time guix-list-get-time 20 t) - (path guix-list-get-file-path 30 t)) + (path guix-list-get-file-name 30 t)) :titles '((number . "N.")) :sort-key '(number . t) :marks '((delete . ?D))) diff --git a/emacs/guix-ui-package.el b/emacs/guix-ui-package.el index 29514527ce..414bc9b9d2 100644 --- a/emacs/guix-ui-package.el +++ b/emacs/guix-ui-package.el @@ -35,6 +35,8 @@ (require 'guix-entry) (require 'guix-utils) (require 'guix-hydra-build) +(require 'guix-read) +(require 'guix-license) (guix-ui-define-entry-type package) (guix-ui-define-entry-type output) @@ -220,7 +222,7 @@ ENTRIES is a list of package entries to get info about packages." (source simple guix-package-info-insert-source) (location format (format guix-package-location)) (home-url format (format guix-url)) - (license format (format guix-package-info-license)) + (license format (format guix-package-license)) (systems format guix-package-info-insert-systems) (inputs format (format guix-package-input)) (native-inputs format (format guix-package-native-input)) @@ -338,6 +340,13 @@ formatted with this string, an action button is inserted.") 'action (lambda (btn) (guix-find-location (button-label btn)))) +(define-button-type 'guix-package-license + :supertype 'guix + 'face 'guix-package-info-license + 'help-echo "Browse license URL" + 'action (lambda (btn) + (guix-browse-license-url (button-label btn)))) + (define-button-type 'guix-package-name :supertype 'guix 'face 'guix-package-info-name-button @@ -767,7 +776,7 @@ for all ARGS." (dependencies simple (indent guix-file)) (location format (format guix-package-location)) (home-url format (format guix-url)) - (license format (format guix-package-info-license)) + (license format (format guix-package-license)) (systems format guix-package-info-insert-systems) (inputs format (format guix-package-input)) (native-inputs format (format guix-package-native-input)) @@ -925,6 +934,17 @@ Interactively with prefix, prompt for 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. PARAMS are package parameters that should be searched. diff --git a/emacs/guix-ui-system-generation.el b/emacs/guix-ui-system-generation.el index d79f3bceef..7f4d76d489 100644 --- a/emacs/guix-ui-system-generation.el +++ b/emacs/guix-ui-system-generation.el @@ -71,7 +71,7 @@ SEARCH-VALUES." (current guix-generation-list-get-current 10 t) (label nil 40 t) (time guix-list-get-time 20 t) - (path guix-list-get-file-path 30 t)) + (path guix-list-get-file-name 30 t)) :titles guix-generation-list-titles :sort-key '(number . t) :marks '((delete . ?D))) |