diff options
Diffstat (limited to 'emacs')
| -rw-r--r-- | emacs/guix-backend.el | 24 | ||||
| -rw-r--r-- | emacs/guix-base.el | 62 | ||||
| -rw-r--r-- | emacs/guix-config.el.in | 2 | ||||
| -rw-r--r-- | emacs/guix-license.el | 103 | ||||
| -rw-r--r-- | emacs/guix-location.el | 79 | ||||
| -rw-r--r-- | emacs/guix-main.scm | 42 | ||||
| -rw-r--r-- | emacs/guix-messages.el | 15 | ||||
| -rw-r--r-- | emacs/guix-read.el | 11 | ||||
| -rw-r--r-- | emacs/guix-ui-license.el | 150 | ||||
| -rw-r--r-- | emacs/guix-ui-location.el | 83 | ||||
| -rw-r--r-- | emacs/guix-ui-package.el | 41 | ||||
| -rw-r--r-- | emacs/guix-ui.el | 33 | ||||
| -rw-r--r-- | emacs/guix-utils.el | 28 | ||||
| -rw-r--r-- | emacs/local.mk | 76 |
14 files changed, 574 insertions, 175 deletions
diff --git a/emacs/guix-backend.el b/emacs/guix-backend.el index 8afbc9ed48..6341aacae1 100644 --- a/emacs/guix-backend.el +++ b/emacs/guix-backend.el @@ -82,7 +82,7 @@ If you have a slow system, try to increase this time." :type 'string :group 'guix-repl) -(defcustom guix-after-start-repl-hook () +(defcustom guix-after-start-repl-hook '(guix-set-directory) "Hook called after Guix REPL is started." :type 'hook :group 'guix-repl) @@ -337,6 +337,28 @@ additional internal REPL if it exists." (geiser-repl--switch-to-buffer (guix-get-repl-buffer internal))) +;;; Guix directory + +(defvar guix-directory nil + "Default directory with Guix source. +If it is not set by a user, it is set after starting Guile REPL. +This directory is used to define package locations.") + +(defun guix-read-directory () + "Return `guix-directory' or prompt for it. +This function is intended for using in `interactive' forms." + (if current-prefix-arg + (read-directory-name "Directory with Guix modules: " + guix-directory) + guix-directory)) + +(defun guix-set-directory () + "Set `guix-directory' if needed." + (or guix-directory + (setq guix-directory + (guix-eval-read "%guix-dir")))) + + ;;; Evaluating expressions (defvar guix-operation-buffer nil diff --git a/emacs/guix-base.el b/emacs/guix-base.el index 75d19cbfe0..888836428f 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -48,53 +48,7 @@ (when output (concat ":" output)))) -;;; Location of packages, profiles and manifests - -(defvar guix-directory nil - "Default Guix directory. -If it is not set by a user, it is set after starting Guile REPL. -This directory is used to define location of the packages.") - -(defun guix-read-directory () - "Return `guix-directory' or prompt for it. -This function is intended for using in `interactive' forms." - (if current-prefix-arg - (read-directory-name "Directory with Guix modules: " - guix-directory) - guix-directory)) - -(defun guix-set-directory () - "Set `guix-directory' if needed." - (or guix-directory - (setq guix-directory - (guix-eval-read "%guix-dir")))) - -(add-hook 'guix-after-start-repl-hook 'guix-set-directory) - -(defun guix-find-location (location &optional directory) - "Go to LOCATION of a package. -LOCATION is a string of the form: - - \"PATH:LINE:COLUMN\" - -If PATH is relative, it is considered to be relative to -DIRECTORY (`guix-directory' by default)." - (cl-multiple-value-bind (path line col) - (split-string location ":") - (let ((file (expand-file-name path (or directory guix-directory))) - (line (string-to-number line)) - (col (string-to-number col))) - (find-file file) - (goto-char (point-min)) - (forward-line (- line 1)) - (move-to-column col) - (recenter 1)))) - -(defun guix-package-location (id-or-name) - "Return location of a package with ID-OR-NAME. -For the meaning of location, see `guix-find-location'." - (guix-eval-read (guix-make-guile-expression - 'package-location-string id-or-name))) +;;; Location of profiles and manifests (defun guix-generation-file (profile generation) "Return the file name of a PROFILE's GENERATION." @@ -120,20 +74,6 @@ See `guix-packages-profile'." (expand-file-name "manifest" (guix-packages-profile profile generation system?))) -;;;###autoload -(defun guix-edit (id-or-name &optional directory) - "Edit (go to location of) package with ID-OR-NAME. -See `guix-find-location' for the meaning of package location and -DIRECTORY. -Interactively, with prefix argument, prompt for DIRECTORY." - (interactive - (list (guix-read-package-name) - (guix-read-directory))) - (let ((loc (guix-package-location id-or-name))) - (if loc - (guix-find-location loc directory) - (message "Couldn't find package location.")))) - ;;; Actions on packages and generations diff --git a/emacs/guix-config.el.in b/emacs/guix-config.el.in index bd821596c4..d03df9ce63 100644 --- a/emacs/guix-config.el.in +++ b/emacs/guix-config.el.in @@ -24,7 +24,7 @@ (replace-regexp-in-string "${prefix}" "@prefix@" "@emacsuidir@")) (defconst guix-config-state-directory - ;; This must match `NIX_STATE_DIR' as defined in `daemon.am'. + ;; This must match `NIX_STATE_DIR' as defined in `nix/local.mk'. (or (getenv "NIX_STATE_DIR") "@guix_localstatedir@/guix")) (defconst guix-config-guile-program "@GUILE@" diff --git a/emacs/guix-license.el b/emacs/guix-license.el index a99d7af98d..6003a21aac 100644 --- a/emacs/guix-license.el +++ b/emacs/guix-license.el @@ -23,14 +23,15 @@ ;;; 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-license-file (&optional directory) + "Return name of the file with license definitions. +DIRECTORY is a directory with Guix source (`guix-directory' by default)." + (expand-file-name "guix/licenses.scm" + (or directory guix-directory))) (defun guix-lookup-license-url (license) "Return URL of a LICENSE." @@ -38,80 +39,20 @@ '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-find-license-definition (license &optional directory) + "Open licenses file from DIRECTORY and move to the LICENSE definition. +See `guix-license-file' for the meaning of DIRECTORY. +Interactively, with prefix argument, prompt for DIRECTORY." + (interactive + (list (guix-read-license-name) + (guix-read-directory))) + (find-file (guix-license-file directory)) + (goto-char (point-min)) + (when (re-search-forward (concat "\"" (regexp-quote license) "\"") + nil t) + (beginning-of-defun) + (recenter 1))) ;;;###autoload (defun guix-browse-license-url (license) @@ -119,12 +60,6 @@ SEARCH-TYPE may be one of the following symbols: `all', `id', `name'." (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-location.el b/emacs/guix-location.el new file mode 100644 index 0000000000..81396b4017 --- /dev/null +++ b/emacs/guix-location.el @@ -0,0 +1,79 @@ +;;; guix-location.el --- Package locations + +;; 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 Location as published by +;; the Free Software Foundation, either version 3 of the Location, 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 Location for more details. + +;; You should have received a copy of the GNU General Public Location +;; along with this program. If not, see <http://www.gnu.org/locations/>. + +;;; Commentary: + +;; This file provides the code to work with locations of Guix packages. + +;;; Code: + +(require 'cl-lib) +(require 'guix-backend) +(require 'guix-read) +(require 'guix-guile) + +(defun guix-package-location (id-or-name) + "Return location of a package with ID-OR-NAME. +For the meaning of location, see `guix-find-location'." + (guix-eval-read (guix-make-guile-expression + 'package-location-string id-or-name))) + +;;;###autoload +(defun guix-find-location (location &optional directory) + "Go to LOCATION of a package. +LOCATION is a string of the form: + + \"FILE:LINE:COLUMN\" + +If FILE is relative, it is considered to be relative to +DIRECTORY (`guix-directory' by default). + +Interactively, prompt for LOCATION. With prefix argument, prompt +for DIRECTORY as well." + (interactive + (list (guix-read-package-location) + (guix-read-directory))) + (cl-multiple-value-bind (file line column) + (split-string location ":") + (find-file (expand-file-name file (or directory guix-directory))) + (when (and line column) + (let ((line (string-to-number line)) + (column (string-to-number column))) + (goto-char (point-min)) + (forward-line (- line 1)) + (move-to-column column) + (recenter 1))))) + +;;;###autoload +(defun guix-edit (id-or-name &optional directory) + "Edit (go to location of) package with ID-OR-NAME. +See `guix-find-location' for the meaning of package location and +DIRECTORY. +Interactively, with prefix argument, prompt for DIRECTORY." + (interactive + (list (guix-read-package-name) + (guix-read-directory))) + (let ((loc (guix-package-location id-or-name))) + (if loc + (guix-find-location loc directory) + (message "Couldn't find package location.")))) + +(provide 'guix-location) + +;;; guix-location.el ends here diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm index c62044056f..5358f3bfa4 100644 --- a/emacs/guix-main.scm +++ b/emacs/guix-main.scm @@ -684,6 +684,8 @@ ENTRIES is a list of installed manifest entries." (license-proc (lambda (_ license-name) (packages-by-license (lookup-license license-name)))) + (location-proc (lambda (_ location) + (packages-by-location-file location))) (all-proc (lambda _ (all-available-packages))) (newest-proc (lambda _ (newest-available-packages)))) `((package @@ -693,6 +695,7 @@ ENTRIES is a list of installed manifest entries." (obsolete . ,(apply-to-first obsolete-package-patterns)) (regexp . ,regexp-proc) (license . ,license-proc) + (location . ,location-proc) (all-available . ,all-proc) (newest-available . ,newest-proc)) (output @@ -702,6 +705,7 @@ ENTRIES is a list of installed manifest entries." (obsolete . ,(apply-to-first obsolete-output-patterns)) (regexp . ,regexp-proc) (license . ,license-proc) + (location . ,location-proc) (all-available . ,all-proc) (newest-available . ,newest-proc))))) @@ -1097,3 +1101,41 @@ Return #t if the shell command was executed successfully." (define (license-entries search-type . search-values) (map license->sexp (apply find-licenses search-type search-values))) + + +;;; Package locations + +(define-values (packages-by-location-file + package-location-files) + (let* ((table (delay (fold-packages + (lambda (package table) + (let ((file (location-file + (package-location package)))) + (vhash-cons file package table))) + vlist-null))) + (files (delay (vhash-fold + (lambda (file _ result) + (if (member file result) + result + (cons file result))) + '() + (force table))))) + (values + (lambda (file) + "Return the (possibly empty) list of packages defined in location FILE." + (vhash-fold* cons '() file (force table))) + (lambda () + "Return the list of file names of all package locations." + (force files))))) + +(define %package-location-param-alist + `((id . ,identity) + (location . ,identity) + (number-of-packages . ,(lambda (location) + (length (packages-by-location-file location)))))) + +(define package-location->sexp + (object-transformer %package-location-param-alist)) + +(define (package-location-entries) + (map package-location->sexp (package-location-files))) diff --git a/emacs/guix-messages.el b/emacs/guix-messages.el index de0331fff8..7ebe7e8b5c 100644 --- a/emacs/guix-messages.el +++ b/emacs/guix-messages.el @@ -40,6 +40,10 @@ ,(lambda (_ entries licenses) (apply #'guix-message-packages-by-license entries 'package licenses))) + (location + ,(lambda (_ entries locations) + (apply #'guix-message-packages-by-location + entries 'package locations))) (regexp (0 "No packages matching '%s'." val) (1 "A single package matching '%s'." val) @@ -72,6 +76,10 @@ ,(lambda (_ entries licenses) (apply #'guix-message-packages-by-license entries 'output licenses))) + (location + ,(lambda (_ entries locations) + (apply #'guix-message-packages-by-location + entries 'output locations))) (regexp (0 "No package outputs matching '%s'." val) (1 "A single package output matching '%s'." val) @@ -174,6 +182,13 @@ Try \"M-x guix-search-by-name\"." (str-end (format "with license '%s'" license))) (message "%s %s." str-beg str-end))) +(defun guix-message-packages-by-location (entries entry-type location) + "Display a message for packages or outputs searched by LOCATION." + (let* ((count (length entries)) + (str-beg (guix-message-string-entries count entry-type)) + (str-end (format "placed in '%s'" location))) + (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 a1a6b86364..5423c9bcfa 100644 --- a/emacs/guix-read.el +++ b/emacs/guix-read.el @@ -62,6 +62,12 @@ "Return a list of names of available licenses." (guix-eval-read (guix-make-guile-expression 'license-names))) +(guix-memoized-defun guix-package-locations () + "Return a list of available package locations." + (sort (guix-eval-read (guix-make-guile-expression + 'package-location-files)) + #'string<)) + ;;; Readers @@ -131,6 +137,11 @@ :single-reader guix-read-license-name :single-prompt "License: ") +(guix-define-readers + :completions-getter guix-package-locations + :single-reader guix-read-package-location + :single-prompt "Location: ") + (provide 'guix-read) ;;; guix-read.el ends here diff --git a/emacs/guix-ui-license.el b/emacs/guix-ui-license.el new file mode 100644 index 0000000000..cf1b5cd357 --- /dev/null +++ b/emacs/guix-ui-license.el @@ -0,0 +1,150 @@ +;;; guix-ui-license.el --- Interface for displaying 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 'list'/'info' interface for displaying licenses of +;; Guix packages. + +;;; Code: + +(require 'guix-buffer) +(require 'guix-list) +(require 'guix-info) +(require 'guix-backend) +(require 'guix-guile) +(require 'guix-license) + +(guix-define-entry-type 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)) + +(defun guix-license-message (entries search-type &rest args) + "Display a message after showing license ENTRIES." + ;; Some objects in (guix licenses) module are procedures (e.g., + ;; 'non-copyleft' or 'x11-style'). Such licenses cannot be "described". + (when (null entries) + (if (cdr args) + (message "Unknown licenses.") + (message "Unknown license.")))) + + +;;; License 'info' + +(guix-info-define-interface license + :buffer-name "*Guix License Info*" + :get-entries-function 'guix-license-get-entries + :message-function 'guix-license-message + :format '((name ignore (simple guix-info-heading)) + ignore + guix-license-insert-packages-button + (url ignore (simple guix-url)) + guix-license-insert-comment + ignore + guix-license-insert-file) + :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." + (let ((license (guix-entry-value entry 'name))) + (guix-info-insert-action-button + "Packages" + (lambda (btn) + (guix-packages-by-license (button-get btn 'license))) + (format "Display packages with license '%s'" license) + 'license license))) + +(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)))) + +(defun guix-license-insert-file (entry) + "Insert button to open license definition." + (let ((license (guix-entry-value entry 'name))) + (guix-insert-button + (guix-license-file) 'guix-file + 'help-echo (format "Open definition of license '%s'" license) + 'action (lambda (btn) + (guix-find-license-definition (button-get btn 'license))) + 'license license))) + + +;;; License 'list' + +(guix-list-define-interface license + :buffer-name "*Guix Licenses*" + :get-entries-function 'guix-license-get-entries + :describe-function 'guix-license-list-describe + :message-function 'guix-license-message + :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 "e") 'guix-license-list-edit) + (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))) + +(defun guix-license-list-edit (&optional directory) + "Go to the location of the current license definition. +See `guix-license-file' for the meaning of DIRECTORY." + (interactive (list (guix-read-directory))) + (guix-find-license-definition (guix-list-current-id) directory)) + + +;;; Interactive commands + +;;;###autoload +(defun guix-licenses () + "Display licenses of the Guix packages." + (interactive) + (guix-license-get-display 'all)) + +(provide 'guix-ui-license) + +;;; guix-ui-license.el ends here diff --git a/emacs/guix-ui-location.el b/emacs/guix-ui-location.el new file mode 100644 index 0000000000..0027c1fba8 --- /dev/null +++ b/emacs/guix-ui-location.el @@ -0,0 +1,83 @@ +;;; guix-ui-location.el --- Interface for displaying package locations + +;; 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 Location as published by +;; the Free Software Foundation, either version 3 of the Location, 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 Location for more details. + +;; You should have received a copy of the GNU General Public Location +;; along with this program. If not, see <http://www.gnu.org/locations/>. + +;;; Commentary: + +;; This file provides a 'list' interface for displaying locations of Guix +;; packages. + +;;; Code: + +(require 'guix-buffer) +(require 'guix-list) +(require 'guix-location) +(require 'guix-backend) + +(guix-define-entry-type location) + +(defun guix-location-get-entries () + "Receive 'package location' entries." + (guix-eval-read "(package-location-entries)")) + + +;;; Location 'list' + +(guix-list-define-interface location + :buffer-name "*Guix Package Locations*" + :get-entries-function 'guix-location-get-entries + :format '((location guix-location-list-file-name-specification 50 t) + (number-of-packages nil 10 guix-list-sort-numerically-1 + :right-align t)) + :sort-key '(location)) + +(let ((map guix-location-list-mode-map)) + (define-key map (kbd "RET") 'guix-location-list-show-packages) + ;; "Location Info" buffer is not defined (it would be useless), so + ;; unbind "i" key (by default, it is used to display Info buffer). + (define-key map (kbd "i") nil)) + +(defun guix-location-list-file-name-specification (location &optional _) + "Return LOCATION button specification for `tabulated-list-entries'." + (list location + 'face 'guix-list-file-name + 'action (lambda (btn) + (guix-find-location (button-get btn 'location))) + 'follow-link t + 'help-echo (concat "Find location: " location) + 'location location)) + +(declare-function guix-packages-by-location "guix-ui-package") + +(defun guix-location-list-show-packages () + "Display packages placed in the location at point." + (interactive) + (guix-packages-by-location (guix-list-current-id))) + + +;;; Interactive commands + +;;;###autoload +(defun guix-locations () + "Display locations of the Guix packages." + (interactive) + (guix-list-get-display-entries 'location)) + +(provide 'guix-ui-location) + +;;; guix-ui-location.el ends here diff --git a/emacs/guix-ui-package.el b/emacs/guix-ui-package.el index df5f8d12d1..38f0c08fc7 100644 --- a/emacs/guix-ui-package.el +++ b/emacs/guix-ui-package.el @@ -1,6 +1,6 @@ ;;; guix-ui-package.el --- Interface for displaying packages -*- lexical-binding: t -*- -;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> +;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com> ;; This file is part of GNU Guix. @@ -38,6 +38,7 @@ (require 'guix-hydra-build) (require 'guix-read) (require 'guix-license) +(require 'guix-location) (require 'guix-profiles) (guix-ui-define-entry-type package) @@ -222,7 +223,7 @@ ENTRIES is a list of package entries to get info about packages." ignore (outputs simple guix-package-info-insert-outputs) (source simple guix-package-info-insert-source) - (location format (format guix-package-location)) + (location simple guix-package-info-insert-location) (home-url format (format guix-url)) (license format (format guix-package-license)) (systems format guix-package-info-insert-systems) @@ -345,9 +346,13 @@ formatted with this string, an action button is inserted.") (define-button-type 'guix-package-license :supertype 'guix 'face 'guix-package-info-license - 'help-echo "Browse license URL" + 'help-echo "Display license info" 'action (lambda (btn) - (guix-browse-license-url (button-label btn)))) + (require 'guix-ui-license) + (guix-buffer-get-display-entries + 'info 'license + (list 'name (button-label btn)) + 'add))) (define-button-type 'guix-package-name :supertype 'guix @@ -382,6 +387,22 @@ formatted with this string, an action button is inserted.") 'guix-package-heading 'spec (guix-package-entry->name-specification entry))) +(defun guix-package-info-insert-location (location &optional _) + "Insert package LOCATION at point." + (if (null location) + (guix-format-insert nil) + (let ((location-file (car (split-string location ":")))) + (guix-info-insert-value-indent location 'guix-package-location) + (guix-info-insert-indent) + (guix-info-insert-action-button + "Packages" + (lambda (btn) + (guix-package-get-display (guix-ui-current-profile) + 'location + (button-get btn 'location))) + (format "Display packages from location '%s'" location-file) + 'location location-file)))) + (defun guix-package-info-insert-systems (systems entry) "Insert supported package SYSTEMS at point." (guix-info-insert-value-format @@ -797,7 +818,7 @@ for all ARGS." (source simple guix-package-info-insert-source) (path simple (indent guix-file)) (dependencies simple (indent guix-file)) - (location format (format guix-package-location)) + (location simple guix-package-info-insert-location) (home-url format (format guix-url)) (license format (format guix-package-license)) (systems format guix-package-info-insert-systems) @@ -970,6 +991,16 @@ Interactively with prefix, prompt for PROFILE." (guix-package-get-display profile 'license license)) ;;;###autoload +(defun guix-packages-by-location (location &optional profile) + "Display Guix packages placed in LOCATION file. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (guix-read-package-location) + (guix-ui-read-profile))) + (guix-package-get-display profile 'location location)) + +;;;###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.el b/emacs/guix-ui.el index 9a88efc286..1b696314cd 100644 --- a/emacs/guix-ui.el +++ b/emacs/guix-ui.el @@ -1,6 +1,6 @@ ;;; guix-ui.el --- Common code for Guix package management interface -*- lexical-binding: t -*- -;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> +;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com> ;; This file is part of GNU Guix. @@ -105,10 +105,11 @@ If `all', update all Guix buffers (not recommended)." :group 'guix-ui) (defcustom guix-ui-buffer-name-function - #'guix-ui-buffer-name-default + #'guix-ui-buffer-name-full "Function used to define a name of a Guix buffer. The function is called with 2 arguments: BASE-NAME and PROFILE." - :type '(choice (function-item guix-ui-buffer-name-default) + :type '(choice (function-item guix-ui-buffer-name-full) + (function-item guix-ui-buffer-name-short) (function-item guix-ui-buffer-name-simple) (function :tag "Other function")) :group 'guix-ui) @@ -117,26 +118,14 @@ The function is called with 2 arguments: BASE-NAME and PROFILE." "Return BASE-NAME." base-name) -;; TODO separate '*...*' logic from the real profile appending. Also add -;; another function to return '*Guix ...: /full/path/to/profile*' name. -(defun guix-ui-buffer-name-default (base-name profile) +(defun guix-ui-buffer-name-short (base-name profile) "Return buffer name by appending BASE-NAME and PROFILE's base file name." - (let ((profile-name (file-name-base (directory-file-name profile))) - (re (rx string-start - (group (? "*")) - (group (*? any)) - (group (? "*")) - string-end))) - (or (string-match re base-name) - (error "Unexpected error in defining guix buffer name")) - (let ((first* (match-string 1 base-name)) - (name-body (match-string 2 base-name)) - (last* (match-string 3 base-name))) - ;; Handle the case when buffer name is wrapped by '*'. - (if (and (string= "*" first*) - (string= "*" last*)) - (concat "*" name-body ": " profile-name "*") - (concat base-name ": " profile-name))))) + (guix-compose-buffer-name base-name + (file-name-base (directory-file-name profile)))) + +(defun guix-ui-buffer-name-full (base-name profile) + "Return buffer name by appending BASE-NAME and PROFILE's full name." + (guix-compose-buffer-name base-name profile)) (defun guix-ui-buffer-name (base-name profile) "Return Guix buffer name based on BASE-NAME and profile. diff --git a/emacs/guix-utils.el b/emacs/guix-utils.el index 8c1a5b42de..ea9933f5c3 100644 --- a/emacs/guix-utils.el +++ b/emacs/guix-utils.el @@ -1,6 +1,6 @@ ;;; guix-utils.el --- General utility functions -*- lexical-binding: t -*- -;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> +;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com> ;; This file is part of GNU Guix. @@ -223,6 +223,32 @@ If NO-MESSAGE? is non-nil, do not display a message about it." See also `guix-copy-as-kill'." (guix-copy-as-kill (guix-command-string args) no-message?)) +(defun guix-compose-buffer-name (base-name postfix) + "Return buffer name by appending BASE-NAME and POSTFIX. + +In a simple case the result is: + + BASE-NAME: POSTFIX + +If BASE-NAME is wrapped by '*', then the result is: + + *BASE-NAME: POSTFIX*" + (let ((re (rx string-start + (group (? "*")) + (group (*? any)) + (group (? "*")) + string-end))) + (or (string-match re base-name) + (error "Unexpected error in defining buffer name")) + (let ((first* (match-string 1 base-name)) + (name-body (match-string 2 base-name)) + (last* (match-string 3 base-name))) + ;; Handle the case when buffer name is wrapped by '*'. + (if (and (string= "*" first*) + (string= "*" last*)) + (concat "*" name-body ": " postfix "*") + (concat base-name ": " postfix))))) + (defun guix-completing-read (prompt table &optional predicate require-match initial-input hist def inherit-input-method) diff --git a/emacs/local.mk b/emacs/local.mk new file mode 100644 index 0000000000..62e33e4fd2 --- /dev/null +++ b/emacs/local.mk @@ -0,0 +1,76 @@ +# GNU Guix --- Functional package management for GNU +# Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com> +# Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> +# +# 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +AUTOLOADS = emacs/guix-autoloads.el + +ELFILES = \ + emacs/guix-backend.el \ + emacs/guix-base.el \ + emacs/guix-build-log.el \ + emacs/guix-buffer.el \ + emacs/guix-command.el \ + emacs/guix-devel.el \ + emacs/guix-emacs.el \ + emacs/guix-entry.el \ + emacs/guix-external.el \ + emacs/guix-geiser.el \ + emacs/guix-guile.el \ + emacs/guix-help-vars.el \ + emacs/guix-history.el \ + emacs/guix-hydra.el \ + emacs/guix-hydra-build.el \ + emacs/guix-hydra-jobset.el \ + emacs/guix-info.el \ + emacs/guix-init.el \ + emacs/guix-license.el \ + emacs/guix-list.el \ + emacs/guix-location.el \ + emacs/guix-messages.el \ + emacs/guix-pcomplete.el \ + emacs/guix-popup.el \ + emacs/guix-prettify.el \ + emacs/guix-profiles.el \ + emacs/guix-read.el \ + emacs/guix-ui.el \ + emacs/guix-ui-license.el \ + emacs/guix-ui-location.el \ + emacs/guix-ui-package.el \ + emacs/guix-ui-generation.el \ + emacs/guix-ui-system-generation.el \ + emacs/guix-utils.el + +if HAVE_EMACS + +dist_lisp_DATA = $(ELFILES) + +nodist_lisp_DATA = \ + emacs/guix-config.el \ + $(AUTOLOADS) + +$(AUTOLOADS): $(ELFILES) + $(AM_V_EMACS)$(EMACS) --batch --eval \ + "(let ((backup-inhibited t) \ + (generated-autoload-file \ + (expand-file-name \"$(AUTOLOADS)\" \"$(builddir)\"))) \ + (update-directory-autoloads \ + (expand-file-name \"emacs\" \"$(srcdir)\")))" + +CLEANFILES += $(AUTOLOADS) + +endif HAVE_EMACS |